home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / cgi386.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  259KB  |  6,010 lines
  1. {
  2.     $Id: cgi386.pas,v 1.3.2.2 1998/08/18 13:48:34 carl Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl
  4.  
  5.     This unit generates i386 (or better) assembler from the parse tree
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23.  
  24. {$ifdef tp}
  25. {$E+,F+,N+,D+,L+,Y+}
  26. {$endif}
  27. unit cgi386;
  28.  
  29.  
  30. {***************************************************************************}
  31. interface
  32. {***************************************************************************}
  33.  
  34. uses    objects,verbose,cobjects,systems,globals,tree,
  35.         symtable,types,strings,pass_1,hcodegen,
  36.         aasm,i386,tgeni386,files,cgai386
  37. {$ifdef GDB}
  38.         ,gdb
  39. {$endif GDB}
  40. {$ifdef TP}
  41.         ,cgi3862
  42. {$endif TP}
  43.         ;
  44.  
  45. { produces assembler for the expression in variable p }
  46. { and produces an assembler node at the end           }
  47. procedure generatecode(var p : ptree);
  48.  
  49. { produces the actual code }
  50. function do_secondpass(var p : ptree) : boolean;
  51.  
  52. procedure secondpass(var p : ptree);
  53.  
  54. {$ifdef test_dest_loc}
  55. const   { used to avoid temporary assignments }
  56.         dest_loc_known : boolean = false;
  57.         in_dest_loc : boolean = false;
  58.         dest_loc_tree : ptree = nil;
  59.  
  60. var dest_loc : tlocation;
  61.  
  62. procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  63.  
  64. {$endif test_dest_loc}
  65.  
  66.  
  67.  
  68.  
  69. {***************************************************************************}
  70. implementation
  71. {***************************************************************************}
  72.  
  73.     const
  74.        never_copy_const_param : boolean = false;
  75.  
  76. {$ifdef test_dest_loc}
  77.        procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  78.  
  79.          begin
  80.             if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
  81.               begin
  82.                 emit_reg_reg(A_MOV,s,reg,dest_loc.register);
  83.                 p^.location:=dest_loc;
  84.                 in_dest_loc:=true;
  85.               end
  86.             else
  87.             if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
  88.               begin
  89.                 exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,s,reg,newreference(dest_loc.reference))));
  90.                 p^.location:=dest_loc;
  91.                 in_dest_loc:=true;
  92.               end
  93.             else
  94.               internalerror(20080);
  95.          end;
  96.  
  97. {$endif test_dest_loc}
  98.  
  99.      const
  100.        bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
  101.  
  102.     procedure error(const t : tmsgconst);
  103.  
  104.       begin
  105.          if not(codegenerror) then
  106.            verbose.Message(t);
  107.          codegenerror:=true;
  108.       end;
  109.  
  110.     type
  111.        secondpassproc = procedure(var p : ptree);
  112.  
  113.     procedure seconderror(var p : ptree);
  114.  
  115.       begin
  116.          p^.error:=true;
  117.          codegenerror:=true;
  118.       end;
  119.  
  120.     var
  121.        { this is for open arrays and strings        }
  122.        { but be careful, this data is in the        }
  123.        { generated code destroyed quick, and also   }
  124.        { the next call of secondload destroys this  }
  125.        { data                                       }
  126.        { So be careful using the informations       }
  127.        { provided by this variables                 }
  128.        highframepointer : tregister;
  129.        highoffset : longint;
  130.  
  131. {$ifndef TP}
  132.  
  133. {$I cgi386ad.inc}
  134.  
  135. {$endif TP}
  136.  
  137.     procedure secondload(var p : ptree);
  138.  
  139.       var
  140.          hregister : tregister;
  141.          symtabletype : tsymtabletype;
  142.          i : longint;
  143.          hp : preference;
  144.  
  145.       begin
  146.          simple_loadn:=true;
  147.          reset_reference(p^.location.reference);
  148.          case p^.symtableentry^.typ of
  149.               { this is only for toasm and toaddr }
  150.               absolutesym :
  151.                  begin
  152.                     stringdispose(p^.location.reference.symbol);
  153.                     if (pabsolutesym(p^.symtableentry)^.abstyp=toaddr) then
  154.                      begin
  155.                        if pabsolutesym(p^.symtableentry)^.absseg then
  156.                         p^.location.reference.segment:=R_FS;
  157.                        p^.location.reference.offset:=pabsolutesym(p^.symtableentry)^.address;
  158.                      end
  159.                     else
  160.                      p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  161.                     if p^.symtableentry^.owner^.symtabletype=unitsymtable then
  162.                       concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  163.                  end;
  164.               varsym :
  165.                  begin
  166.                     hregister:=R_NO;
  167.                     symtabletype:=p^.symtable^.symtabletype;
  168.                     { in case it is a register variable: }
  169.                     if pvarsym(p^.symtableentry)^.reg<>R_NO then
  170.                       begin
  171.                          p^.location.loc:=LOC_CREGISTER;
  172.                          p^.location.register:=pvarsym(p^.symtableentry)^.reg;
  173.                          unused:=unused-[pvarsym(p^.symtableentry)^.reg];
  174.                       end
  175.                     else
  176.                       begin
  177.                          { first handle local and temporary variables }
  178.                          if (symtabletype=parasymtable) or (symtabletype=localsymtable) then
  179.                            begin
  180.                               p^.location.reference.base:=procinfo.framepointer;
  181.                               p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
  182.                               if (symtabletype=localsymtable) then
  183.                                 p^.location.reference.offset:=-p^.location.reference.offset;
  184.                               if (symtabletype=parasymtable) then
  185.                                 inc(p^.location.reference.offset,p^.symtable^.call_offset);
  186.                               if (lexlevel>(p^.symtable^.symtablelevel)) then
  187.                                 begin
  188.                                    hregister:=getregister32;
  189.  
  190.                                    { make a reference }
  191.                                    new(hp);
  192.                                    reset_reference(hp^);
  193.                                    hp^.offset:=procinfo.framepointer_offset;
  194.                                    hp^.base:=procinfo.framepointer;
  195.  
  196.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
  197.  
  198.                                    simple_loadn:=false;
  199.                                    i:=lexlevel-1;
  200.                                    while i>(p^.symtable^.symtablelevel) do
  201.                                      begin
  202.                                         { make a reference }
  203.                                         new(hp);
  204.                                         reset_reference(hp^);
  205.                                         hp^.offset:=8;
  206.                                         hp^.base:=hregister;
  207.  
  208.                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
  209.                                         dec(i);
  210.                                      end;
  211.                                    p^.location.reference.base:=hregister;
  212.                                 end;
  213.                            end
  214.                          else
  215.                            case symtabletype of
  216.                               unitsymtable,globalsymtable,
  217.                               staticsymtable : begin
  218.                                                   stringdispose(p^.location.reference.symbol);
  219.                                                   p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  220.                                                   if symtabletype=unitsymtable then
  221.                                                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  222.                                                end;
  223.                               objectsymtable : begin
  224.                                                   if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
  225.                                                     begin
  226.                                                        stringdispose(p^.location.reference.symbol);
  227.                                                        p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  228.                                                        if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
  229.                                                          concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  230.                                                     end
  231.                                                   else
  232.                                                     begin
  233.                                                        p^.location.reference.base:=R_ESI;
  234.                                                        p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
  235.                                                     end;
  236.                                                end;
  237.                               withsymtable:
  238.                                 begin
  239.                                    hregister:=getregister32;
  240.                                    p^.location.reference.base:=hregister;
  241.                                    { make a reference }
  242.                                    new(hp);
  243.                                    reset_reference(hp^);
  244.                                    hp^.offset:=p^.symtable^.datasize;
  245.                                    hp^.base:=procinfo.framepointer;
  246.  
  247.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
  248.  
  249.                                    p^.location.reference.offset:=
  250.                                      pvarsym(p^.symtableentry)^.address;
  251.                                 end;
  252.                            end;
  253.                          { in case call by reference, then calculate: }
  254.                          if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
  255.                             ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
  256.                              dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then
  257.                            begin
  258.                               simple_loadn:=false;
  259.                               if hregister=R_NO then
  260.                                 hregister:=getregister32;
  261.                               if (p^.location.reference.base=procinfo.framepointer) then
  262.                                 begin
  263.                                    highframepointer:=p^.location.reference.base;
  264.                                    highoffset:=p^.location.reference.offset;
  265.                                 end
  266.                               else
  267.                                 begin
  268.                                    highframepointer:=R_EDI;
  269.                                    highoffset:=p^.location.reference.offset;
  270.                                    exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
  271.                                      p^.location.reference.base,R_EDI)));
  272.                                 end;
  273.                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),
  274.                                 hregister)));
  275.                               clear_reference(p^.location.reference);
  276.                               p^.location.reference.base:=hregister;
  277.                           end;
  278.                          {
  279.                          if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
  280.                            ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
  281.                            begin
  282.                               simple_loadn:=false;
  283.                               if hregister=R_NO then
  284.                                 hregister:=getregister32;
  285.                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),
  286.                                 hregister)));
  287.                               clear_reference(p^.location.reference);
  288.                               p^.location.reference.base:=hregister;
  289.                            end;
  290.                          }
  291.                       end;
  292.                  end;
  293.               procsym:
  294.                  begin
  295.                     {!!!!! Be aware, work on virtual methods too }
  296.                     stringdispose(p^.location.reference.symbol);
  297.                     p^.location.reference.symbol:=
  298.                       stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
  299.                     if p^.symtable^.symtabletype=unitsymtable then
  300.                       concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  301.                  end;
  302.               typedconstsym :
  303.                  begin
  304.                     stringdispose(p^.location.reference.symbol);
  305.                     p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  306.                     if p^.symtable^.symtabletype=unitsymtable then
  307.                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  308.                  end;
  309.               else internalerror(4);
  310.          end;
  311.       end;
  312.  
  313.     procedure secondmoddiv(var p : ptree);
  314.  
  315.       var
  316.          hreg1 : tregister;
  317.          pushed,popeax,popedx : boolean;
  318.          power : longint;
  319.          hl : plabel;
  320.  
  321.       begin
  322.          secondpass(p^.left);
  323.          set_location(p^.location,p^.left^.location);
  324.          pushed:=maybe_push(p^.right^.registers32,p);
  325.          secondpass(p^.right);
  326.          if pushed then restore(p);
  327.  
  328.          { put numerator in register }
  329.          if p^.left^.location.loc<>LOC_REGISTER then
  330.            begin
  331.               if p^.left^.location.loc=LOC_CREGISTER then
  332.                 begin
  333.                   hreg1:=getregister32;
  334.                   emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hreg1);
  335.                 end
  336.               else
  337.                 begin
  338.                   del_reference(p^.left^.location.reference);
  339.                   hreg1:=getregister32;
  340.                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  341.                     hreg1)));
  342.                 end;
  343.               p^.left^.location.loc:=LOC_REGISTER;
  344.               p^.left^.location.register:=hreg1;
  345.            end
  346.          else hreg1:=p^.left^.location.register;
  347.  
  348.            if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
  349.                ispowerof2(p^.right^.value,power) then
  350.              begin
  351.                  exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hreg1,hreg1)));
  352.                  getlabel(hl);
  353.                  emitl(A_JNS,hl);
  354.                  if power=1 then
  355.                     exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,hreg1)))
  356.                  else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,p^.right^.value-1,hreg1)));
  357.  
  358.                  emitl(A_LABEL,hl);
  359.                  exprasmlist^.concat(new(pai386,op_const_reg(A_SAR,S_L,power,hreg1)));
  360.              end
  361.            else
  362.              begin
  363.                  { bring denominator to EDI }
  364.                  { EDI is always free, it's }
  365.                  { only used for temporary  }
  366.                  { purposes                 }
  367.                  if (p^.right^.location.loc<>LOC_REGISTER) and
  368.                      (p^.right^.location.loc<>LOC_CREGISTER) then
  369.                     begin
  370.                        del_reference(p^.right^.location.reference);
  371.                        p^.left^.location.loc:=LOC_REGISTER;
  372.                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
  373.                 end
  374.               else
  375.                 begin
  376.                    ungetregister32(p^.right^.location.register);
  377.                    emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
  378.                 end;
  379.               popedx:=false;
  380.               popeax:=false;
  381.               if hreg1=R_EDX then
  382.                 begin
  383.                        if not(R_EAX in unused) then
  384.                      begin
  385.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  386.                         popeax:=true;
  387.                      end;
  388.                    emit_reg_reg(A_MOV,S_L,R_EDX,R_EAX);
  389.                 end
  390.                  else
  391.                 begin
  392.                    if not(R_EDX in unused) then
  393.                      begin
  394.                               exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
  395.                         popedx:=true;
  396.                      end;
  397.                    if hreg1<>R_EAX then
  398.                      begin
  399.                         if not(R_EAX in unused) then
  400.                           begin
  401.                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  402.                              popeax:=true;
  403.                           end;
  404.                         emit_reg_reg(A_MOV,S_L,hreg1,R_EAX);
  405.                      end;
  406.                 end;
  407.               exprasmlist^.concat(new(pai386,op_none(A_CLTD,S_NO)));
  408.                  exprasmlist^.concat(new(pai386,op_reg(A_IDIV,S_L,R_EDI)));
  409.                  if p^.treetype=divn then
  410.                 begin
  411.                    { if result register is busy then copy }
  412.                    if popeax then
  413.                      begin
  414.                         if hreg1=R_EAX then
  415.                           internalerror(112);
  416.                         emit_reg_reg(A_MOV,S_L,R_EAX,hreg1)
  417.                      end
  418.                    else
  419.                           if hreg1<>R_EAX then
  420.                        emit_reg_reg(A_MOV,S_L,R_EAX,hreg1);
  421.                 end
  422.               else
  423.                 emit_reg_reg(A_MOV,S_L,R_EDX,hreg1);
  424.               if popeax then
  425.                 exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
  426.               if popedx then
  427.                     exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
  428.              end;
  429.            { this registers are always used when div/mod are present }
  430.          usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  431.          usedinproc:=usedinproc or ($80 shr byte(R_EDX));
  432.          p^.location.loc:=LOC_REGISTER;
  433.          p^.location.register:=hreg1;
  434.       end;
  435.  
  436.     procedure secondshlshr(var p : ptree);
  437.  
  438.       var
  439.          hregister1,hregister2,hregister3 : tregister;
  440.          pushed,popecx : boolean;
  441.          op : tasmop;
  442.  
  443.       begin
  444.          popecx:=false;
  445.  
  446.          secondpass(p^.left);
  447.          pushed:=maybe_push(p^.right^.registers32,p);
  448.          secondpass(p^.right);
  449.          if pushed then restore(p);
  450.  
  451.          { load left operators in a register }
  452.          if p^.left^.location.loc<>LOC_REGISTER then
  453.            begin
  454.               if p^.left^.location.loc=LOC_CREGISTER then
  455.                 begin
  456.                    hregister1:=getregister32;
  457.                    emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  458.                      hregister1);
  459.                 end
  460.               else
  461.                 begin
  462.                    del_reference(p^.left^.location.reference);
  463.                    hregister1:=getregister32;
  464.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  465.                      hregister1)));
  466.                 end;
  467.            end
  468.            else hregister1:=p^.left^.location.register;
  469.  
  470.          { determine operator }
  471.          if p^.treetype=shln then
  472.            op:=A_SHL
  473.          else
  474.            op:=A_SHR;
  475.  
  476.          { shifting by a constant directly decode: }
  477.          if (p^.right^.treetype=ordconstn) then
  478.            begin
  479.                  exprasmlist^.concat(new(pai386,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
  480.                 hregister1)));
  481.               p^.location.loc:=LOC_REGISTER;
  482.               p^.location.register:=hregister1;
  483.            end
  484.          else
  485.            begin
  486.               { load right operators in a register }
  487.               if p^.right^.location.loc<>LOC_REGISTER then
  488.                 begin
  489.                        if p^.right^.location.loc=LOC_CREGISTER then
  490.                      begin
  491.                               hregister2:=getregister32;
  492.                         emit_reg_reg(A_MOV,S_L,p^.right^.location.register,
  493.                           hregister2);
  494.                      end
  495.                    else
  496.                      begin
  497.                         del_reference(p^.right^.location.reference);
  498.                         hregister2:=getregister32;
  499.                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),
  500.                           hregister2)));
  501.                      end;
  502.                 end
  503.               else hregister2:=p^.right^.location.register;
  504.  
  505.                  { left operator is already in a register }
  506.               { hence are both in a register }
  507.               { is it in the case ECX ? }
  508.               if (hregister1=R_ECX) then
  509.                 begin
  510.                    { then only swap }
  511.                    emit_reg_reg(A_XCHG,S_L,hregister1,
  512.                      hregister2);
  513.  
  514.                    hregister3:=hregister1;
  515.                    hregister1:=hregister2;
  516.                    hregister2:=hregister3;
  517.                 end
  518.               { if second operator not in ECX ? }
  519.               else if (hregister2<>R_ECX) then
  520.                 begin
  521.                    { ECX not occupied then swap with right register }
  522.                    if R_ECX in unused then
  523.                      begin
  524.                         emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
  525.                         ungetregister32(hregister2);
  526.                           end
  527.                        else
  528.                      begin
  529.                         { else save ECX and then copy it }
  530.                         popecx:=true;
  531.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
  532.                         emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
  533.                         ungetregister32(hregister2);
  534.                      end;
  535.                 end;
  536.               { right operand is in ECX }
  537.               emit_reg_reg(op,S_L,R_CL,hregister1);
  538.               { maybe ECX back }
  539.               if popecx then
  540.                 exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
  541.               p^.location.register:=hregister1;
  542.              end;
  543.          { this register is always used when shl/shr are present }
  544.          usedinproc:=usedinproc or ($80 shr byte(R_ECX));
  545.       end;
  546.  
  547.     procedure secondrealconst(var p : ptree);
  548.  
  549.       var
  550.          hp1 : pai;
  551.          lastlabel : plabel;
  552.          found : boolean;
  553.  
  554.       begin
  555.          clear_reference(p^.location.reference);
  556.          lastlabel:=nil;
  557.          found:=false;
  558.          { const already used ? }
  559.          if p^.labnumber=-1 then
  560.            begin
  561.               { tries to found an old entry }
  562.               hp1:=pai(consts^.first);
  563.               while assigned(hp1) do
  564.                 begin
  565.                    if hp1^.typ=ait_label then
  566.                      lastlabel:=pai_label(hp1)^.l
  567.                    else
  568.                      begin
  569.                         if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
  570.                           begin
  571.                              { Florian this caused a internalerror(10)=> no free reg !! }
  572.                              {if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
  573.                                ((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.valued)) or
  574.                                ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then }
  575.                              if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) then
  576.                                found:=true;
  577.                              if ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) then
  578.                                found:=true;
  579.                              if ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
  580.                                found:=true;
  581.                              if found then
  582.                                begin
  583.                                   { found! }
  584.                                   p^.labnumber:=lastlabel^.nb;
  585.                                   break;
  586.                                end;
  587.                           end;
  588.                         lastlabel:=nil;
  589.                      end;
  590.                    hp1:=pai(hp1^.next);
  591.                 end;
  592.               { :-(, we must generate a new entry }
  593.                  if p^.labnumber=-1 then
  594.                 begin
  595.                    getlabel(lastlabel);
  596.                    p^.labnumber:=lastlabel^.nb;
  597.                    case p^.realtyp of
  598.                      ait_real_64bit : consts^.insert(new(pai_double,init(p^.valued)));
  599.                      ait_real_32bit : consts^.insert(new(pai_single,init(p^.valued)));
  600.                      ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
  601.                      else
  602.                        internalerror(10120);
  603.                      end;
  604. {$ifndef MAKELIB}
  605.                    consts^.insert(new(pai_label,init(lastlabel)));
  606. {$else MAKELIB}
  607.                    consts^.insert(new(pai_symbol,init_global('$'+current_module^.name^
  608.                      +'$real_const'+tostr(p^.labnumber))));
  609.                    consts^.insert(new(pai_cut,init));
  610. {$endif MAKELIB}
  611.                 end;
  612.            end;
  613.          stringdispose(p^.location.reference.symbol);
  614. {$ifndef MAKELIB}
  615.          p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
  616. {$else MAKELIB}
  617.          p^.location.reference.symbol:=stringdup('$'+current_module^.name^
  618.                      +'$real_const'+tostr(p^.labnumber));
  619. {$endif MAKELIB}
  620.       end;
  621.  
  622.     procedure secondfixconst(var p : ptree);
  623.  
  624.       begin
  625.          { an fix comma const. behaves as a memory reference }
  626.          p^.location.loc:=LOC_MEM;
  627.          p^.location.reference.isintvalue:=true;
  628.          p^.location.reference.offset:=p^.valuef;
  629.       end;
  630.  
  631.     procedure secondordconst(var p : ptree);
  632.  
  633.       begin
  634.          { an integer const. behaves as a memory reference }
  635.          p^.location.loc:=LOC_MEM;
  636.          p^.location.reference.isintvalue:=true;
  637.          p^.location.reference.offset:=p^.value;
  638.       end;
  639.  
  640.     procedure secondniln(var p : ptree);
  641.  
  642.       begin
  643.          p^.location.loc:=LOC_MEM;
  644.          p^.location.reference.isintvalue:=true;
  645.          p^.location.reference.offset:=0;
  646.       end;
  647.  
  648.     procedure secondstringconst(var p : ptree);
  649.  
  650.       var
  651.          hp1 : pai;
  652.          lastlabel : plabel;
  653.          pc : pchar;
  654.          same_string : boolean;
  655.          i : word;
  656.  
  657.       begin
  658.          clear_reference(p^.location.reference);
  659.          lastlabel:=nil;
  660.          { const already used ? }
  661.          if p^.labstrnumber=-1 then
  662.            begin
  663.               { tries to found an old entry }
  664.               hp1:=pai(consts^.first);
  665.               while assigned(hp1) do
  666.                 begin
  667.                    if hp1^.typ=ait_label then
  668.                      lastlabel:=pai_label(hp1)^.l
  669.                    else
  670.                      begin
  671.                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
  672.                           (pai_string(hp1)^.len=length(p^.values^)+2) then
  673.                           begin
  674.                              same_string:=true;
  675.                              for i:=1 to length(p^.values^) do
  676.                                if pai_string(hp1)^.str[i]<>p^.values^[i] then
  677.                                  begin
  678.                                     same_string:=false;
  679.                                     break;
  680.                                  end;
  681.                              if same_string then
  682.                                begin
  683.                                   { found! }
  684.                                   p^.labstrnumber:=lastlabel^.nb;
  685.                                   break;
  686.                                end;
  687.                           end;
  688.                         lastlabel:=nil;
  689.                      end;
  690.                    hp1:=pai(hp1^.next);
  691.                 end;
  692.               { :-(, we must generate a new entry }
  693.               if p^.labstrnumber=-1 then
  694.                 begin
  695.                    getlabel(lastlabel);
  696.                    p^.labstrnumber:=lastlabel^.nb;
  697.                    getmem(pc,length(p^.values^)+3);
  698.                    move(p^.values^,pc^,length(p^.values^)+1);
  699.                    pc[length(p^.values^)+1]:=#0;
  700.                    { we still will have a problem if there is a #0 inside the pchar }
  701.                    consts^.insert(new(pai_string,init_pchar(pc)));
  702.                    { to overcome this problem we set the length explicitly }
  703.                    { with the ending null char }
  704.                    pai_string(consts^.first)^.len:=length(p^.values^)+2;
  705. {$ifndef MAKELIB}
  706.                    consts^.insert(new(pai_label,init(lastlabel)));
  707. {$else MAKELIB}
  708.                    consts^.insert(new(pai_symbol,init_global('$'+current_module^.name^
  709.                      +'$string_const'+tostr(p^.labstrnumber))));
  710.                    consts^.insert(new(pai_cut,init));
  711. {$endif MAKELIB}
  712.                 end;
  713.            end;
  714.          stringdispose(p^.location.reference.symbol);
  715. {$ifndef MAKELIB}
  716.          p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
  717. {$else MAKELIB}
  718.          p^.location.reference.symbol:=stringdup('$'+current_module^.name^
  719.                      +'$string_const'+tostr(p^.labstrnumber));
  720. {$endif MAKELIB}
  721.          p^.location.loc := LOC_MEM;
  722.       end;
  723.  
  724.     procedure secondumminus(var p : ptree);
  725.  
  726. {$ifdef SUPPORT_MMX}
  727.       procedure do_mmx_neg;
  728.  
  729.         var
  730.            op : tasmop;
  731.  
  732.         begin
  733.            p^.location.loc:=LOC_MMXREGISTER;
  734.            if cs_mmx_saturation in aktswitches then
  735.              case mmx_type(p^.resulttype) of
  736.                 mmxs8bit:
  737.                   op:=A_PSUBSB;
  738.                 mmxu8bit:
  739.                   op:=A_PSUBUSB;
  740.                 mmxs16bit,mmxfixed16:
  741.                   op:=A_PSUBSW;
  742.                 mmxu16bit:
  743.                   op:=A_PSUBUSW;
  744.              end
  745.            else
  746.              case mmx_type(p^.resulttype) of
  747.                 mmxs8bit,mmxu8bit:
  748.                   op:=A_PSUBB;
  749.                 mmxs16bit,mmxu16bit,mmxfixed16:
  750.                   op:=A_PSUBW;
  751.                 mmxs32bit,mmxu32bit:
  752.                   op:=A_PSUBD;
  753.              end;
  754.            emit_reg_reg(op,S_NO,p^.location.register,R_MM7);
  755.            emit_reg_reg(A_MOVQ,S_NO,R_MM7,p^.location.register);
  756.         end;
  757. {$endif}
  758.  
  759.       begin
  760.          secondpass(p^.left);
  761.          p^.location.loc:=LOC_REGISTER;
  762.          case p^.left^.location.loc of
  763.             LOC_REGISTER:
  764.               begin
  765.                  p^.location.register:=p^.left^.location.register;
  766.                  exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
  767.               end;
  768.             LOC_CREGISTER:
  769.               begin
  770.                  p^.location.register:=getregister32;
  771.                  emit_reg_reg(A_MOV,S_L,p^.location.register,
  772.                    p^.location.register);
  773.                  exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
  774.               end;
  775. {$ifdef SUPPORT_MMX}
  776.             LOC_MMXREGISTER:
  777.               begin
  778.                  p^.location:=p^.left^.location;
  779.                  emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
  780.                  do_mmx_neg;
  781.               end;
  782.             LOC_CMMXREGISTER:
  783.               begin
  784.                  p^.location.register:=getregistermmx;
  785.                  emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
  786.                  emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
  787.                    p^.location.register);
  788.                  do_mmx_neg;
  789.               end;
  790. {$endif SUPPORT_MMX}
  791.             LOC_REFERENCE,LOC_MEM:
  792.                            begin
  793.                               del_reference(p^.left^.location.reference);
  794.                               if (p^.left^.resulttype^.deftype=floatdef) and
  795.                                  (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
  796.                                 begin
  797.                                    p^.location.loc:=LOC_FPU;
  798.                                    floatload(pfloatdef(p^.left^.resulttype)^.typ,
  799.                                      p^.left^.location.reference);
  800.                                    exprasmlist^.concat(new(pai386,op_none(A_FCHS,S_NO)));
  801.                                 end
  802. {$ifdef SUPPORT_MMX}
  803.                               else if (cs_mmx in aktswitches) and is_mmx_able_array(p^.left^.resulttype) then
  804.                                 begin
  805.                                    p^.location.register:=getregistermmx;
  806.                                    emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
  807.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
  808.                                      newreference(p^.left^.location.reference),
  809.                                      p^.location.register)));
  810.                                    do_mmx_neg;
  811.                                 end
  812. {$endif SUPPORT_MMX}
  813.                               else
  814.                                 begin
  815.                                    p^.location.register:=getregister32;
  816.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  817.                                      newreference(p^.left^.location.reference),
  818.                                      p^.location.register)));
  819.                                    exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
  820.                                 end;
  821.                            end;
  822.             LOC_FPU:
  823.               begin
  824.                  p^.location.loc:=LOC_FPU;
  825.                  exprasmlist^.concat(new(pai386,op_none(A_FCHS,S_NO)));
  826.               end;
  827.          end;
  828. { Here was a problem...            }
  829. { Operand to be negated always     }
  830. { seems to be converted to signed  }
  831. { 32-bit before doing neg!!        }
  832. { So this is useless...            }
  833. {         emitoverflowcheck(p);}
  834.       end;
  835.  
  836.     procedure secondaddr(var p : ptree);
  837.  
  838.       begin
  839.          secondpass(p^.left);
  840.          p^.location.loc:=LOC_REGISTER;
  841.          del_reference(p^.left^.location.reference);
  842.          p^.location.register:=getregister32;
  843.          {@ on a procvar means returning an address to the procedure that
  844.            is stored in it.}
  845.          { yes but p^.left^.symtableentry can be nil
  846.            for example on @self !! }
  847.          { symtableentry can be also invalid, if left is no tree node }
  848.          if (p^.left^.treetype=loadn) and
  849.            assigned(p^.left^.symtableentry) and
  850.            (p^.left^.symtableentry^.typ=varsym) and
  851.            (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
  852.            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  853.              newreference(p^.left^.location.reference),
  854.              p^.location.register)))
  855.          else
  856.            exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  857.              newreference(p^.left^.location.reference),
  858.              p^.location.register)));
  859.            { for use of other segments }
  860.            if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  861.              p^.location.segment:=p^.left^.location.reference.segment;
  862.       end;
  863.  
  864.     procedure seconddoubleaddr(var p : ptree);
  865.  
  866.       begin
  867.          secondpass(p^.left);
  868.          p^.location.loc:=LOC_REGISTER;
  869.          del_reference(p^.left^.location.reference);
  870.          p^.location.register:=getregister32;
  871.          exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  872.          newreference(p^.left^.location.reference),
  873.            p^.location.register)));
  874.       end;
  875.  
  876.     procedure secondnot(var p : ptree);
  877.  
  878.       const
  879.          flagsinvers : array[F_E..F_BE] of tresflags =
  880.             (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
  881.              F_A,F_AE,F_B,F_BE);
  882.  
  883.       var
  884.          hl : plabel;
  885.  
  886.       begin
  887.          if (p^.resulttype^.deftype=orddef) and
  888.             (porddef(p^.resulttype)^.typ=bool8bit) then
  889.               begin
  890.                  case p^.location.loc of
  891.                     LOC_JUMP : begin
  892.                                   hl:=truelabel;
  893.                                   truelabel:=falselabel;
  894.                                   falselabel:=hl;
  895.                                   secondpass(p^.left);
  896.                                   maketojumpbool(p^.left);
  897.                                   hl:=truelabel;
  898.                                   truelabel:=falselabel;
  899.                                   falselabel:=hl;
  900.                                end;
  901.                     LOC_FLAGS : begin
  902.                                    secondpass(p^.left);
  903.                                    p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
  904.                                 end;
  905.                     LOC_REGISTER : begin
  906.                                       secondpass(p^.left);
  907.                                       p^.location.register:=p^.left^.location.register;
  908.                                       exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
  909.                                    end;
  910.                     LOC_CREGISTER : begin
  911.                                        secondpass(p^.left);
  912.                                        p^.location.loc:=LOC_REGISTER;
  913.                                        p^.location.register:=reg32toreg8(getregister32);
  914.                                        emit_reg_reg(A_MOV,S_B,p^.left^.location.register,
  915.                                          p^.location.register);
  916.                                        exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
  917.                                     end;
  918.                     LOC_REFERENCE,LOC_MEM : begin
  919.                                               secondpass(p^.left);
  920.                                               del_reference(p^.left^.location.reference);
  921.                                               p^.location.loc:=LOC_REGISTER;
  922.                                               p^.location.register:=reg32toreg8(getregister32);
  923.                                               if p^.left^.location.loc=LOC_CREGISTER then
  924.                                                 emit_reg_reg(A_MOV,S_B,p^.left^.location.register,
  925.                                                    p^.location.register)
  926.                                               else
  927.                                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
  928.                                               newreference(p^.left^.location.reference),
  929.                                                 p^.location.register)));
  930.                                               exprasmlist^.concat(new(pai386,op_const_reg(A_XOR,S_B,1,p^.location.register)));
  931.                                            end;
  932.                  end;
  933.               end
  934. {$ifdef SUPPORT_MMX}
  935.             else if (cs_mmx in aktswitches) and is_mmx_able_array(p^.left^.resulttype) then
  936.               begin
  937.                  secondpass(p^.left);
  938.                  p^.location.loc:=LOC_MMXREGISTER;
  939.                  { prepare EDI }
  940.                  exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,$ffffffff,R_EDI)));
  941.                  { load operand }
  942.                  case p^.left^.location.loc of
  943.                     LOC_MMXREGISTER:
  944.                       p^.location:=p^.left^.location;
  945.                     LOC_CMMXREGISTER:
  946.                       begin
  947.                          p^.location.register:=getregistermmx;
  948.                          emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
  949.                            p^.location.register);
  950.                       end;
  951.                     LOC_REFERENCE,LOC_MEM:
  952.                       begin
  953.                          del_reference(p^.left^.location.reference);
  954.                          p^.location.register:=getregistermmx;
  955.                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
  956.                            newreference(p^.left^.location.reference),
  957.                            p^.location.register)));
  958.                       end;
  959.                  end;
  960.                  { load mask }
  961.                  emit_reg_reg(A_MOV,S_D,R_EDI,R_MM7);
  962.                  { lower 32 bit }
  963.                  emit_reg_reg(A_PXOR,S_D,R_MM7,p^.location.register);
  964.                  { shift mask }
  965.                  exprasmlist^.concat(new(pai386,op_const_reg(A_PSLLQ,S_NO,
  966.                    32,R_MM7)));
  967.                  { higher 32 bit }
  968.                  emit_reg_reg(A_PXOR,S_D,R_MM7,p^.location.register);
  969.               end
  970. {$endif SUPPORT_MMX}
  971.             else
  972.               begin
  973.                 secondpass(p^.left);
  974.                 p^.location.loc:=LOC_REGISTER;
  975.  
  976.                 case p^.left^.location.loc of
  977.                    LOC_REGISTER : begin
  978.                                      p^.location.register:=p^.left^.location.register;
  979.                                      exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
  980.                                   end;
  981.                    LOC_CREGISTER : begin
  982.                                      p^.location.register:=getregister32;
  983.                                      emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  984.                                        p^.location.register);
  985.                                      exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
  986.                                    end;
  987.                    LOC_REFERENCE,LOC_MEM :
  988.                                   begin
  989.                                      del_reference(p^.left^.location.reference);
  990.                                      p^.location.register:=getregister32;
  991.                                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  992.                                        newreference(p^.left^.location.reference),
  993.                                        p^.location.register)));
  994.                                      exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
  995.                                   end;
  996.                 end;
  997.                 {if  p^.left^.location.loc=loc_register then
  998.                   p^.location.register:=p^.left^.location.register
  999.                 else
  1000.                   begin
  1001.                      del_locref(p^.left^.location);
  1002.                      p^.location.register:=getregister32;
  1003.                      exprasmlist^.concat(new(pai386,op_loc_reg(A_MOV,S_L,
  1004.                        p^.left^.location,
  1005.                        p^.location.register)));
  1006.                   end;
  1007.                 exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));}
  1008.  
  1009.              end;
  1010.       end;
  1011.  
  1012.     procedure secondnothing(var p : ptree);
  1013.  
  1014.       begin
  1015.       end;
  1016.  
  1017.     procedure secondderef(var p : ptree);
  1018.  
  1019.       var
  1020.          hr : tregister;
  1021.  
  1022.       begin
  1023.          secondpass(p^.left);
  1024.          clear_reference(p^.location.reference);
  1025.          case p^.left^.location.loc of
  1026.             LOC_REGISTER:
  1027.               p^.location.reference.base:=p^.left^.location.register;
  1028.             LOC_CREGISTER:
  1029.               begin
  1030.                  { ... and reserve one for the pointer }
  1031.                  hr:=getregister32;
  1032.                  emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  1033.                  p^.location.reference.base:=hr;
  1034.               end;
  1035.             else
  1036.               begin
  1037.                  { free register }
  1038.                  del_reference(p^.left^.location.reference);
  1039.  
  1040.                  { ...and reserve one for the pointer }
  1041.                  hr:=getregister32;
  1042.                  exprasmlist^.concat(new(pai386,op_ref_reg(
  1043.                    A_MOV,S_L,newreference(p^.left^.location.reference),
  1044.                    hr)));
  1045.                  p^.location.reference.base:=hr;
  1046.               end;
  1047.          end;
  1048.       end;
  1049.  
  1050.     procedure secondvecn(var p : ptree);
  1051.  
  1052.       var
  1053.          pushed : boolean;
  1054.          ind,hr : tregister;
  1055.          _p : ptree;
  1056.  
  1057.        function get_mul_size:longint;
  1058.          begin
  1059.            if p^.memindex then
  1060.              get_mul_size:=1
  1061.            else
  1062.              get_mul_size:=p^.resulttype^.size;
  1063.          end;
  1064.  
  1065.  
  1066.       procedure calc_emit_mul;
  1067.  
  1068.         var
  1069.            l1,l2 : longint;
  1070.  
  1071.           begin
  1072.            l1:=get_mul_size;
  1073.            case l1 of
  1074.               1,2,4,8 : p^.location.reference.scalefactor:=l1;
  1075.            else
  1076.                 begin
  1077.                    if ispowerof2(l1,l2) then
  1078.                      exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,l2,ind)))
  1079.                    else
  1080.                      exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,l1,ind)));
  1081.                 end;
  1082.            end;
  1083.         end;
  1084.  
  1085.       var
  1086.          extraoffset : longint;
  1087.            t : ptree;
  1088.            hp : preference;
  1089.            tai:Pai386;
  1090.  
  1091.       begin
  1092.          secondpass(p^.left);
  1093.          set_location(p^.location,p^.left^.location);
  1094.  
  1095.          { offset can only differ from 0 if arraydef }
  1096.          if p^.left^.resulttype^.deftype=arraydef then
  1097.            dec(p^.location.reference.offset,
  1098.                get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  1099.          if p^.right^.treetype=ordconstn then
  1100.            begin
  1101.               { offset can only differ from 0 if arraydef }
  1102.               if (p^.left^.resulttype^.deftype=arraydef) then
  1103.                 begin
  1104.                    if not(is_open_array(p^.left^.resulttype)) then
  1105.                          begin
  1106.                         if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
  1107.                            (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
  1108.                           Message(parser_e_range_check_error);
  1109.  
  1110.                         dec(p^.left^.location.reference.offset,
  1111.                             get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  1112.                          end
  1113.                    else
  1114.                      begin
  1115.                         { range checking for open arrays }
  1116.                      end;
  1117.                 end;
  1118.               inc(p^.left^.location.reference.offset,
  1119.                   get_mul_size*p^.right^.value);
  1120.               if p^.memseg then
  1121.                 p^.left^.location.reference.segment:=R_FS;
  1122.               p^.left^.resulttype:=p^.resulttype;
  1123.               disposetree(p^.right);
  1124.               _p:=p^.left;
  1125.               putnode(p);
  1126.               p:=_p;
  1127.            end
  1128.          else
  1129.            begin
  1130.                  { quick hack, to overcome Delphi 2 }
  1131.               if (cs_maxoptimieren in aktswitches) and
  1132.                 (p^.left^.resulttype^.deftype=arraydef) then
  1133.                 begin
  1134.                    extraoffset:=0;
  1135.                    if (p^.right^.treetype=addn) then
  1136.                      begin
  1137.                         if p^.right^.right^.treetype=ordconstn then
  1138.                           begin
  1139.                              extraoffset:=p^.right^.right^.value;
  1140.                              t:=p^.right^.left;
  1141.                              putnode(p^.right);
  1142.                              putnode(p^.right^.right);
  1143.                              p^.right:=t
  1144.                           end
  1145.                         else if p^.right^.left^.treetype=ordconstn then
  1146.                           begin
  1147.                              extraoffset:=p^.right^.left^.value;
  1148.                              t:=p^.right^.right;
  1149.                                            putnode(p^.right);
  1150.                              putnode(p^.right^.left);
  1151.                              p^.right:=t
  1152.                           end;
  1153.                      end
  1154.                    else if (p^.right^.treetype=subn) then
  1155.                      begin
  1156.                                     if p^.right^.right^.treetype=ordconstn then
  1157.                           begin
  1158.                              extraoffset:=p^.right^.right^.value;
  1159.                              t:=p^.right^.left;
  1160.                              putnode(p^.right);
  1161.                              putnode(p^.right^.right);
  1162.                              p^.right:=t
  1163.                           end
  1164.                         else if p^.right^.left^.treetype=ordconstn then
  1165.                           begin
  1166.                              extraoffset:=p^.right^.left^.value;
  1167.                                            t:=p^.right^.right;
  1168.                              putnode(p^.right);
  1169.                              putnode(p^.right^.left);
  1170.                              p^.right:=t
  1171.                           end;
  1172.                      end;
  1173.                    inc(p^.location.reference.offset,
  1174.                        get_mul_size*extraoffset);
  1175.                 end;
  1176.               { calculate from left to right }
  1177.               if (p^.location.loc<>LOC_REFERENCE) and
  1178.                  (p^.location.loc<>LOC_MEM) then
  1179.                 Message(cg_e_illegal_expression);
  1180.               pushed:=maybe_push(p^.right^.registers32,p);
  1181.               secondpass(p^.right);
  1182.               if pushed then restore(p);
  1183.                 case p^.right^.location.loc of
  1184.                    LOC_REGISTER:
  1185.                      begin
  1186.                         ind:=p^.right^.location.register;
  1187.                         case p^.right^.resulttype^.size of
  1188.                            1:
  1189.                              begin
  1190.                                 hr:=reg8toreg32(ind);
  1191.                                 emit_reg_reg(A_MOVZX,S_BL,ind,hr);
  1192.                                 ind:=hr;
  1193.                              end;
  1194.                            2:
  1195.                              begin
  1196.                                 hr:=reg16toreg32(ind);
  1197.                                 emit_reg_reg(A_MOVZX,S_WL,ind,hr);
  1198.                                  ind:=hr;
  1199.                              end;
  1200.                         end;
  1201.                      end;
  1202.                    LOC_CREGISTER:
  1203.                      begin
  1204.                         ind:=getregister32;
  1205.                         case p^.right^.resulttype^.size of
  1206.                            1:
  1207.                              emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
  1208.                            2:
  1209.                              emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
  1210.                            4:
  1211.                              emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
  1212.                         end;
  1213.                      end;
  1214.                    LOC_FLAGS:
  1215.                      begin
  1216.                         ind:=getregister32;
  1217.                         exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,reg32toreg8(ind))));
  1218.                         emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
  1219.                      end
  1220.                    else
  1221.                       begin
  1222.                          del_reference(p^.right^.location.reference);
  1223.                          ind:=getregister32;
  1224.                          { Booleans are stored in an 8 bit memory location, so
  1225.                            the use of MOVL is not correct }
  1226.                          case p^.right^.resulttype^.size of
  1227.                            1:
  1228.                              tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
  1229.                            2:
  1230.                              tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
  1231.                            4:
  1232.                              tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
  1233.                          end;
  1234.                          exprasmlist^.concat(tai);
  1235.                       end;
  1236.                 end;
  1237.               { produce possible range check code: }
  1238.               if cs_rangechecking in aktswitches  then
  1239.                 begin
  1240.                    if p^.left^.resulttype^.deftype=arraydef then
  1241.                      begin
  1242.                         new(hp);
  1243.                         reset_reference(hp^);
  1244.                         parraydef(p^.left^.resulttype)^.genrangecheck;
  1245.                         hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
  1246.                         exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
  1247.                      end;
  1248.                 end;
  1249.               if p^.location.reference.index=R_NO then
  1250.                 begin
  1251.                    p^.location.reference.index:=ind;
  1252.                    calc_emit_mul;
  1253.                 end
  1254.               else
  1255.                 begin
  1256.                    if p^.location.reference.base=R_NO then
  1257.                      begin
  1258.                         case p^.location.reference.scalefactor of
  1259.                            2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
  1260.                            4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
  1261.                            8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
  1262.                         end;
  1263.                         calc_emit_mul;
  1264.                         p^.location.reference.base:=p^.location.reference.index;
  1265.                         p^.location.reference.index:=ind;
  1266.                      end
  1267.                    else
  1268.                      begin
  1269.                         exprasmlist^.concat(new(pai386,op_ref_reg(
  1270.                           A_LEA,S_L,newreference(p^.location.reference),
  1271.                           p^.location.reference.index)));
  1272.                         ungetregister32(p^.location.reference.base);
  1273.                         { the symbol offset is loaded,               }
  1274.                         { so release the symbol name and set symbol  }
  1275.                         { to nil                                     }
  1276.                         stringdispose(p^.location.reference.symbol);
  1277.                         p^.location.reference.offset:=0;
  1278.                         calc_emit_mul;
  1279.                         p^.location.reference.base:=p^.location.reference.index;
  1280.                         p^.location.reference.index:=ind;
  1281.                      end;
  1282.                 end;
  1283.              if p^.memseg then
  1284.                p^.location.reference.segment:=R_FS;
  1285.            end;
  1286.       end;
  1287.  
  1288.     { *************** Converting Types **************** }
  1289.  
  1290.     { produces if necessary rangecheckcode }
  1291.  
  1292.      procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
  1293.  
  1294.        var
  1295.           hp : preference;
  1296.           hregister : tregister;
  1297.           neglabel,poslabel : plabel;
  1298.           is_register : boolean;
  1299.  
  1300.       begin
  1301.          { convert from p2 to p1 }
  1302.          { range check from enums is not made yet !!}
  1303.          { and its probably not easy }
  1304.          if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
  1305.            exit;
  1306.          { range checking is different for u32bit }
  1307.          { lets try to generate it allways }
  1308.          if (cs_rangechecking in aktswitches)  and
  1309.            { with $R+ explicit type conversations in TP aren't range checked! }
  1310.            (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
  1311.            ((porddef(p1)^.von>porddef(p2)^.von) or
  1312.            (porddef(p1)^.bis<porddef(p2)^.bis) or
  1313.            (porddef(p1)^.typ=u32bit) or
  1314.            (porddef(p2)^.typ=u32bit)) then
  1315.            begin
  1316.               porddef(p1)^.genrangecheck;
  1317.               is_register:=(p^.left^.location.loc=LOC_REGISTER) or
  1318.                 (p^.left^.location.loc=LOC_CREGISTER);
  1319.               if porddef(p2)^.typ=u8bit then
  1320.                 begin
  1321.                    if is_register then
  1322.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)))
  1323.                    else
  1324.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
  1325.                    hregister:=R_EDI;
  1326.                 end
  1327.               else if porddef(p2)^.typ=s8bit then
  1328.                 begin
  1329.                    if is_register then
  1330.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)))
  1331.                    else
  1332.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
  1333.                    hregister:=R_EDI;
  1334.                 end
  1335.               { rangechecking for u32bit ?? !!!!!!}
  1336.               { lets try }
  1337.               else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit)  then
  1338.                 begin
  1339.                    if is_register then
  1340.                      hregister:=p^.location.register
  1341.                    else
  1342.                      begin
  1343.                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),R_EDI)));
  1344.                         hregister:=R_EDI;
  1345.                      end;
  1346.                 end
  1347.               else if porddef(p2)^.typ=u16bit then
  1348.                 begin
  1349.                    if is_register then
  1350.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)))
  1351.                    else
  1352.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
  1353.                    hregister:=R_EDI;
  1354.                 end
  1355.               else if porddef(p2)^.typ=s16bit then
  1356.                 begin
  1357.                    if is_register then
  1358.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)))
  1359.                    else
  1360.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
  1361.                    hregister:=R_EDI;
  1362.                 end
  1363.               else internalerror(6);
  1364.               new(hp);
  1365.               reset_reference(hp^);
  1366.               hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
  1367.               if porddef(p1)^.von>porddef(p1)^.bis then
  1368.                 begin
  1369.                    getlabel(neglabel);
  1370.                    getlabel(poslabel);
  1371.                    exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
  1372.                    emitl(A_JL,neglabel);
  1373.                 end;
  1374.               exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
  1375.               if porddef(p1)^.von>porddef(p1)^.bis then
  1376.                 begin
  1377.                    new(hp);
  1378.                    reset_reference(hp^);
  1379.                    hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
  1380.                    emitl(A_JMP,poslabel);
  1381.                    emitl(A_LABEL,neglabel);
  1382.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
  1383.                    emitl(A_LABEL,poslabel);
  1384.                 end;
  1385.  
  1386.            end;
  1387.       end;
  1388.  
  1389.      type
  1390.         tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
  1391.  
  1392.     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
  1393.  
  1394.       begin
  1395.       end;
  1396.  
  1397.     procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
  1398.  
  1399.       begin
  1400.          maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
  1401.       end;
  1402.  
  1403.     procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
  1404.  
  1405.       var
  1406.          hregister : tregister;
  1407.          opsize : topsize;
  1408.          op : tasmop;
  1409.          is_register : boolean;
  1410.  
  1411.       begin
  1412.            is_register:=p^.left^.location.loc=LOC_REGISTER;
  1413.            if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
  1414.              begin
  1415.                 del_reference(p^.left^.location.reference);
  1416.                 { we can do this here as we need no temp inside second_bigger }
  1417.                 ungetiftemp(p^.left^.location.reference);
  1418.              end;
  1419.          { this is wrong !!!
  1420.          gives me movl (%eax),%eax
  1421.          for the length(string !!!
  1422.          use only for constant values }
  1423.            {Constanst cannot be loaded into registers using MOVZX!}
  1424.            if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
  1425.                 case convtyp of
  1426.                     tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
  1427.                       begin
  1428.                           if is_register then
  1429.                             hregister:=reg8toreg32(p^.left^.location.register)
  1430.                           else hregister:=getregister32;
  1431.                           op:=A_MOVZX;
  1432.                           opsize:=S_BL;
  1433.                       end;
  1434.                     { here what do we do for negative values ? }
  1435.                     tc_s8bit_2_s32bit,tc_s8bit_2_u32bit :
  1436.                       begin
  1437.                           if is_register then
  1438.                             hregister:=reg8toreg32(p^.left^.location.register)
  1439.                           else hregister:=getregister32;
  1440.                           op:=A_MOVSX;
  1441.                           opsize:=S_BL;
  1442.                       end;
  1443.                     tc_u16bit_2_s32bit,tc_u16bit_2_u32bit :
  1444.                       begin
  1445.                           if is_register then
  1446.                             hregister:=reg16toreg32(p^.left^.location.register)
  1447.                           else hregister:=getregister32;
  1448.                           op:=A_MOVZX;
  1449.                           opsize:=S_WL;
  1450.                       end;
  1451.                     tc_s16bit_2_s32bit,tc_s16bit_2_u32bit :
  1452.                       begin
  1453.                           if is_register then
  1454.                             hregister:=reg16toreg32(p^.left^.location.register)
  1455.                           else hregister:=getregister32;
  1456.                           op:=A_MOVSX;
  1457.                           opsize:=S_WL;
  1458.                       end;
  1459.                     tc_s8bit_2_u16bit,
  1460.                     tc_u8bit_2_s16bit,
  1461.                     tc_u8bit_2_u16bit :
  1462.                       begin
  1463.                           if is_register then
  1464.                             hregister:=reg8toreg16(p^.left^.location.register)
  1465.                           else hregister:=reg32toreg16(getregister32);
  1466.                           op:=A_MOVZX;
  1467.                           opsize:=S_BW;
  1468.                       end;
  1469.                     tc_s8bit_2_s16bit :
  1470.                       begin
  1471.                           if is_register then
  1472.                             hregister:=reg8toreg16(p^.left^.location.register)
  1473.                           else hregister:=reg32toreg16(getregister32);
  1474.                           op:=A_MOVSX;
  1475.                           opsize:=S_BW;
  1476.                       end;
  1477.                 end
  1478.            else
  1479.                 case convtyp of
  1480.                     tc_u8bit_2_s32bit,
  1481.                     tc_s8bit_2_s32bit,
  1482.                     tc_u16bit_2_s32bit,
  1483.                     tc_s16bit_2_s32bit,
  1484.                     tc_u8bit_2_u32bit,
  1485.                     tc_s8bit_2_u32bit,
  1486.                     tc_u16bit_2_u32bit,
  1487.                     tc_s16bit_2_u32bit:
  1488.                       begin
  1489.                          hregister:=getregister32;
  1490.                          op:=A_MOV;
  1491.                          opsize:=S_L;
  1492.                       end;
  1493.                     tc_s8bit_2_u16bit,
  1494.                     tc_s8bit_2_s16bit,
  1495.                     tc_u8bit_2_s16bit,
  1496.                     tc_u8bit_2_u16bit:
  1497.                       begin
  1498.                          hregister:=reg32toreg16(getregister32);
  1499.                          op:=A_MOV;
  1500.                          opsize:=S_W;
  1501.                      end;
  1502.                 end;
  1503.            if is_register then
  1504.              begin
  1505.                  emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
  1506.              end
  1507.            else
  1508.              begin
  1509.                  if p^.left^.location.loc=LOC_CREGISTER then
  1510.                     emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
  1511.                  else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
  1512.                     newreference(p^.left^.location.reference),hregister)));
  1513.              end;
  1514.            p^.location.loc:=LOC_REGISTER;
  1515.            p^.location.register:=hregister;
  1516.            maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
  1517.        end;
  1518.  
  1519.     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
  1520.  
  1521.       var
  1522.          pushedregs : tpushed;
  1523.  
  1524.       begin
  1525.          stringdispose(p^.location.reference.symbol);
  1526.          gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  1527.          del_reference(p^.left^.location.reference);
  1528.          copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  1529.          ungetiftemp(p^.left^.location.reference);
  1530.       end;
  1531.  
  1532.     procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
  1533.  
  1534.       begin
  1535.          p^.location.loc:=LOC_REGISTER;
  1536.          p^.location.register:=getregister32;
  1537.          inc(p^.left^.location.reference.offset);
  1538.            exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  1539.              p^.location.register)));
  1540.       end;
  1541.  
  1542.     procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
  1543.  
  1544.       begin
  1545.          inc(p^.location.reference.offset);
  1546.       end;
  1547.  
  1548.     procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
  1549.  
  1550.       begin
  1551.          del_reference(p^.left^.location.reference);
  1552.          p^.location.loc:=LOC_REGISTER;
  1553.          p^.location.register:=getregister32;
  1554.          exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  1555.            p^.location.register)));
  1556.       end;
  1557.  
  1558.     procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
  1559.  
  1560.       begin
  1561.          p^.location.loc:=LOC_REFERENCE;
  1562.          clear_reference(p^.location.reference);
  1563.          if p^.left^.location.loc=LOC_REGISTER then
  1564.            p^.location.reference.base:=p^.left^.location.register
  1565.          else
  1566.            begin
  1567.               if p^.left^.location.loc=LOC_CREGISTER then
  1568.                 begin
  1569.                    p^.location.reference.base:=getregister32;
  1570.                    emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  1571.                      p^.location.reference.base);
  1572.                 end
  1573.               else
  1574.                 begin
  1575.                    del_reference(p^.left^.location.reference);
  1576.                    p^.location.reference.base:=getregister32;
  1577.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  1578.                      p^.location.reference.base)));
  1579.                 end;
  1580.            end;
  1581.       end;
  1582.  
  1583.     { generates the code for the type conversion from an array of char }
  1584.     { to a string                                                        }
  1585.     procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
  1586.  
  1587.       var
  1588.          l : longint;
  1589.  
  1590.       begin
  1591.          { this is a type conversion which copies the data, so we can't }
  1592.          { return a reference                                             }
  1593.          p^.location.loc:=LOC_MEM;
  1594.  
  1595.          { first get the memory for the string }
  1596.          stringdispose(p^.location.reference.symbol);
  1597.          gettempofsizereference(256,p^.location.reference);
  1598.  
  1599.          { calc the length of the array }
  1600.          l:=parraydef(p^.left^.resulttype)^.highrange-
  1601.            parraydef(p^.left^.resulttype)^.lowrange+1;
  1602.  
  1603.          if l>255 then
  1604.            Message(sym_e_type_mismatch);
  1605.  
  1606.          { write the length }
  1607.              exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
  1608.                newreference(p^.location.reference))));
  1609.  
  1610.          { copy to first char of string }
  1611.          inc(p^.location.reference.offset);
  1612.  
  1613.          { generates the copy code      }
  1614.          { and we need the source never }
  1615.          concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
  1616.  
  1617.          { correct the string location }
  1618.          dec(p^.location.reference.offset);
  1619.       end;
  1620.  
  1621.     procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
  1622.  
  1623.       begin
  1624.          stringdispose(p^.location.reference.symbol);
  1625.          gettempofsizereference(256,p^.location.reference);
  1626.       { call loadstring with correct left and right }
  1627.          p^.right:=p^.left;
  1628.          p^.left:=p;
  1629.          loadstring(p);
  1630.          p^.left:=nil; { reset left tree, which is empty }
  1631.       end;
  1632.  
  1633.     procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
  1634.  
  1635.       var
  1636.          r : preference;
  1637.  
  1638.       begin
  1639.          if (p^.left^.location.loc=LOC_REGISTER) or
  1640.             (p^.left^.location.loc=LOC_CREGISTER) then
  1641.            begin
  1642.               case porddef(p^.left^.resulttype)^.typ of
  1643.                  s8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)));
  1644.                  u8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)));
  1645.                  s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)));
  1646.                  u16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)));
  1647.                  u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EDI)));
  1648.                  {!!!! u32bit }
  1649.               end;
  1650.               ungetregister(p^.left^.location.register);
  1651.            end
  1652.          else
  1653.            begin
  1654.               r:=newreference(p^.left^.location.reference);
  1655.               case porddef(p^.left^.resulttype)^.typ of
  1656.                  s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,r,R_EDI)));
  1657.                  u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
  1658.                  s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,r,R_EDI)));
  1659.                  u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,r,R_EDI)));
  1660.                  u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1661.                  {!!!! u32bit }
  1662.               end;
  1663.               del_reference(p^.left^.location.reference);
  1664.               ungetiftemp(p^.left^.location.reference);
  1665.          end;
  1666.           if porddef(p^.left^.resulttype)^.typ=u32bit then
  1667.             push_int(0);
  1668.           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
  1669.          new(r);
  1670.          reset_reference(r^);
  1671.          r^.base:=R_ESP;
  1672.          { for u32bit a solution would be to push $0 and to load a
  1673.          comp }
  1674.           if porddef(p^.left^.resulttype)^.typ=u32bit then
  1675.             exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_Q,r)))
  1676.           else
  1677.             exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_L,r)));
  1678.  
  1679.          { better than an add on all processors }
  1680.          if porddef(p^.left^.resulttype)^.typ=u32bit then
  1681.            exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)))
  1682.          else
  1683.            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1684.  
  1685.          p^.location.loc:=LOC_FPU;
  1686.       end;
  1687.  
  1688.     procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
  1689.  
  1690.       var
  1691.          {hs : string;}
  1692.          rreg : tregister;
  1693.          ref : treference;
  1694.  
  1695.       begin
  1696.          { real must be on fpu stack }
  1697.          if (p^.left^.location.loc<>LOC_FPU) then
  1698.            exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_L,newreference(p^.left^.location.reference))));
  1699.          push_int($1f3f);
  1700.          push_int(65536);
  1701.          reset_reference(ref);
  1702.          ref.base:=R_ESP;
  1703.  
  1704.          exprasmlist^.concat(new(pai386,op_ref(A_FIMUL,S_L,newreference(ref))));
  1705.  
  1706.          ref.offset:=4;
  1707.          exprasmlist^.concat(new(pai386,op_ref(A_FSTCW,S_L,newreference(ref))));
  1708.  
  1709.          ref.offset:=6;
  1710.          exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
  1711.  
  1712.          ref.offset:=0;
  1713.          exprasmlist^.concat(new(pai386,op_ref(A_FISTP,S_L,newreference(ref))));
  1714.  
  1715.          ref.offset:=4;
  1716.          exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
  1717.  
  1718.          rreg:=getregister32;
  1719.          exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,rreg)));
  1720.          { better than an add on all processors }
  1721.          exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1722.  
  1723.          p^.location.loc:=LOC_REGISTER;
  1724.          p^.location.register:=rreg;
  1725.       end;
  1726.  
  1727.     procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
  1728.  
  1729.       begin
  1730.          case p^.left^.location.loc of
  1731.             LOC_FPU : ;
  1732.             LOC_MEM,
  1733.             LOC_REFERENCE:
  1734.               begin
  1735.                  floatload(pfloatdef(p^.left^.resulttype)^.typ,
  1736.                    p^.left^.location.reference);
  1737.                  { we have to free the reference }
  1738.                  del_reference(p^.left^.location.reference);
  1739.               end;
  1740.          end;
  1741.          p^.location.loc:=LOC_FPU;
  1742.       end;
  1743.  
  1744.     procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
  1745.  
  1746.     var popeax,popebx,popecx,popedx : boolean;
  1747.         startreg : tregister;
  1748.         hl : plabel;
  1749.         r : treference;
  1750.  
  1751.       begin
  1752.          if (p^.left^.location.loc=LOC_REGISTER) or
  1753.             (p^.left^.location.loc=LOC_CREGISTER) then
  1754.            begin
  1755.               startreg:=p^.left^.location.register;
  1756.               ungetregister(startreg);
  1757.               popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
  1758.               if popeax then
  1759.                 exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  1760.               { mov eax,eax is removed by emit_reg_reg }
  1761.               emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
  1762.            end
  1763.          else
  1764.            begin
  1765.               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
  1766.                 p^.left^.location.reference),R_EAX)));
  1767.               del_reference(p^.left^.location.reference);
  1768.               startreg:=R_NO;
  1769.            end;
  1770.  
  1771.          popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
  1772.          if popebx then
  1773.            exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  1774.  
  1775.          popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
  1776.          if popecx then
  1777.            exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
  1778.  
  1779.          popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
  1780.          if popedx then
  1781.            exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
  1782.  
  1783.          exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
  1784.          emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
  1785.          emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
  1786.          emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
  1787.          getlabel(hl);
  1788.          emitl(A_JZ,hl);
  1789.          exprasmlist^.concat(new(pai386,op_const_reg(A_RCL,S_L,1,R_EBX)));
  1790.          emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
  1791.          exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,32,R_CL)));
  1792.          emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
  1793.          emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
  1794.          exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_W,1007,R_DX)));
  1795.          exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_W,5,R_DX)));
  1796.          exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX)));
  1797.          exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,20,R_EAX,R_EBX)));
  1798.  
  1799.          exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,20,R_EAX)));
  1800.          emitl(A_LABEL,hl);
  1801.          { better than an add on all processors }
  1802.          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
  1803.          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
  1804.  
  1805.          reset_reference(r);
  1806.          r.base:=R_ESP;
  1807.          exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_L,newreference(r))));
  1808.          exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
  1809.          if popedx then
  1810.            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
  1811.          if popecx then
  1812.            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
  1813.          if popebx then
  1814.            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
  1815.          if popeax then
  1816.            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
  1817.  
  1818.          p^.location.loc:=LOC_FPU;
  1819.       end;
  1820.  
  1821.     procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
  1822.  
  1823.       var
  1824.          {hs : string;}
  1825.          hregister : tregister;
  1826.  
  1827.       begin
  1828.          if (p^.left^.location.loc=LOC_REGISTER) then
  1829.            hregister:=p^.left^.location.register
  1830.          else if (p^.left^.location.loc=LOC_CREGISTER) then
  1831.            hregister:=getregister32
  1832.          else
  1833.            begin
  1834.               del_reference(p^.left^.location.reference);
  1835.               hregister:=getregister32;
  1836.               case porddef(p^.left^.resulttype)^.typ of
  1837.                 s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),
  1838.                   hregister)));
  1839.                 u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),
  1840.                   hregister)));
  1841.                 s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),
  1842.                   hregister)));
  1843.                 u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),
  1844.                   hregister)));
  1845.                 u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  1846.                   hregister)));
  1847.                 {!!!! u32bit }
  1848.               end;
  1849.            end;
  1850.          exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
  1851.  
  1852.          p^.location.loc:=LOC_REGISTER;
  1853.          p^.location.register:=hregister;
  1854.       end;
  1855.  
  1856.     procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
  1857.  
  1858.       var
  1859.          hregister,destregister : tregister;
  1860.          ref : boolean;
  1861.          hpp : preference;
  1862.  
  1863.       begin
  1864.          ref:=false;
  1865.          { problems with enums !! }
  1866.          if (cs_rangechecking in aktswitches)  and
  1867.            { with $R+ explicit type conversations in TP aren't range checked! }
  1868.            (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
  1869.            (p^.resulttype^.deftype=orddef) and
  1870.            (hp^.resulttype^.deftype=orddef) and
  1871.            ((porddef(p^.resulttype)^.von>porddef(hp^.resulttype)^.von) or
  1872.            (porddef(p^.resulttype)^.bis<porddef(hp^.resulttype)^.bis)) then
  1873.            begin
  1874.               porddef(p^.resulttype)^.genrangecheck;
  1875.               { per default the var is copied to EDI }
  1876.               hregister:=R_EDI;
  1877.               if porddef(hp^.resulttype)^.typ=s32bit then
  1878.                 begin
  1879.                    if (p^.location.loc=LOC_REGISTER) or
  1880.                       (p^.location.loc=LOC_CREGISTER) then
  1881.                      hregister:=p^.location.register
  1882.                    else
  1883.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),R_EDI)));
  1884.                 end
  1885.               { range checking for u32bit ?? !!!!!!}
  1886.               else if porddef(hp^.resulttype)^.typ=u16bit then
  1887.                 begin
  1888.                    if (p^.location.loc=LOC_REGISTER) or
  1889.                       (p^.location.loc=LOC_CREGISTER) then
  1890.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.location.register,R_EDI)))
  1891.                    else
  1892.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.location.reference),R_EDI)));
  1893.                 end
  1894.               else if porddef(hp^.resulttype)^.typ=s16bit then
  1895.                 begin
  1896.                    if (p^.location.loc=LOC_REGISTER) or
  1897.                       (p^.location.loc=LOC_CREGISTER) then
  1898.                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.location.register,R_EDI)))
  1899.                    else
  1900.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.location.reference),R_EDI)));
  1901.                 end
  1902.               else internalerror(6);
  1903.               new(hpp);
  1904.               reset_reference(hpp^);
  1905.               hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
  1906.               exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
  1907.               (*
  1908.               if (p^.location.loc=LOC_REGISTER) or
  1909.                  (p^.location.loc=LOC_CREGISTER) then
  1910.                 begin
  1911.                    destregister:=p^.left^.location.register;
  1912.                    case convtyp of
  1913.                       tc_s32bit_2_s8bit,
  1914.                       tc_s32bit_2_u8bit:
  1915.                         destregister:=reg32toreg8(destregister);
  1916.                       tc_s32bit_2_s16bit,
  1917.                       tc_s32bit_2_u16bit:
  1918.                         destregister:=reg32toreg16(destregister);
  1919.                       { this was false because destregister is allways a 32bitreg }
  1920.                       tc_s16bit_2_s8bit,
  1921.                       tc_s16bit_2_u8bit,
  1922.                       tc_u16bit_2_s8bit,
  1923.                       tc_u16bit_2_u8bit:
  1924.                         destregister:=reg32toreg8(destregister);
  1925.                    end;
  1926.               p^.location.register:=destregister;
  1927.               exit;
  1928.               *)
  1929.            end;
  1930.          { p^.location.loc is already set! }
  1931.          if (p^.location.loc=LOC_REGISTER) or
  1932.            (p^.location.loc=LOC_CREGISTER) then
  1933.            begin
  1934.               destregister:=p^.left^.location.register;
  1935.               case convtyp of
  1936.                  tc_s32bit_2_s8bit,
  1937.                  tc_s32bit_2_u8bit:
  1938.                    destregister:=reg32toreg8(destregister);
  1939.                  tc_s32bit_2_s16bit,
  1940.                  tc_s32bit_2_u16bit:
  1941.                    destregister:=reg32toreg16(destregister);
  1942.                  tc_s16bit_2_s8bit,
  1943.                  tc_s16bit_2_u8bit,
  1944.                  tc_u16bit_2_s8bit,
  1945.                  tc_u16bit_2_u8bit:
  1946.                    destregister:=reg16toreg8(destregister);
  1947.               end;
  1948.               p^.location.register:=destregister;
  1949.            end;
  1950.       end;
  1951.  
  1952.      procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
  1953.  
  1954.      begin
  1955.           secondpass(hp);
  1956.           p^.location.loc:=LOC_REGISTER;
  1957.           del_reference(hp^.location.reference);
  1958.           p^.location.register:=getregister32;
  1959.           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  1960.            newreference(hp^.location.reference),p^.location.register)));
  1961.      end;
  1962.  
  1963.      procedure second_bool_to_byte(p,hp : ptree;convtyp : tconverttype);
  1964.  
  1965.       var
  1966.          oldtruelabel,oldfalselabel,hlabel : plabel;
  1967.  
  1968.      begin
  1969.          oldtruelabel:=truelabel;
  1970.          oldfalselabel:=falselabel;
  1971.          getlabel(truelabel);
  1972.          getlabel(falselabel);
  1973.           secondpass(hp);
  1974.           p^.location.loc:=LOC_REGISTER;
  1975.           del_reference(hp^.location.reference);
  1976.           p^.location.register:=reg32toreg8(getregister32);
  1977.           case hp^.location.loc of
  1978.             LOC_MEM,LOC_REFERENCE :
  1979.               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
  1980.                 newreference(hp^.location.reference),p^.location.register)));
  1981.             LOC_REGISTER,LOC_CREGISTER :
  1982.               exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_B,
  1983.                 hp^.location.register,p^.location.register)));
  1984.            LOC_FLAGS:
  1985.               begin
  1986.                  exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_NO,
  1987.                    p^.location.register)))
  1988.               end;
  1989.            LOC_JUMP:
  1990.              begin
  1991.                 getlabel(hlabel);
  1992.                 emitl(A_LABEL,truelabel);
  1993.                 exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,
  1994.                   1,p^.location.register)));
  1995.                 emitl(A_JMP,hlabel);
  1996.                 emitl(A_LABEL,falselabel);
  1997.                 exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,
  1998.                   p^.location.register,
  1999.                   p^.location.register)));
  2000.                 emitl(A_LABEL,hlabel);
  2001.              end;
  2002.           else
  2003.             internalerror(10060);
  2004.           end;
  2005.          truelabel:=oldtruelabel;
  2006.          falselabel:=oldfalselabel;
  2007.      end;
  2008.  
  2009.     procedure secondtypeconv(var p : ptree);
  2010.  
  2011.       const
  2012.          secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
  2013.            tsecondconvproc = (second_bigger,second_only_rangecheck,
  2014.            second_bigger,second_bigger,second_bigger,
  2015.            second_smaller,second_smaller,
  2016.            second_smaller,second_string_string,
  2017.            second_cstring_charpointer,second_string_chararray,
  2018.            second_array_to_pointer,second_pointer_to_array,
  2019.            second_char_to_string,second_bigger,
  2020.            second_bigger,second_bigger,
  2021.            second_smaller,second_smaller,
  2022.            second_smaller,second_smaller,
  2023.            second_bigger,second_smaller,
  2024.            second_only_rangecheck,second_bigger,
  2025.            second_bigger,second_bigger,
  2026.            second_bigger,second_only_rangecheck,
  2027.            second_int_real,second_real_fix,
  2028.            second_fix_real,second_int_fix,second_float_float,
  2029.                second_chararray_to_string,second_bool_to_byte,
  2030.                second_proc_to_procvar,
  2031.                { is constant char to pchar, is done by firstpass }
  2032.                second_nothing);
  2033.  
  2034.       begin
  2035.          { this isn't good coding, I think tc_bool_2_u8bit, shouldn't be }
  2036.          { type conversion (FK)                                        }
  2037.  
  2038.          { this is necessary, because second_bool_byte, have to change   }
  2039.          { true- and false label before calling secondpass               }
  2040.          if p^.convtyp<>tc_bool_2_u8bit then
  2041.            begin
  2042.               secondpass(p^.left);
  2043.               set_location(p^.location,p^.left^.location);
  2044.            end;
  2045.          if p^.convtyp<>tc_equal then
  2046.            {the second argument only is for maybe_range_checking !}
  2047.            secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
  2048.       end;
  2049.  
  2050.  
  2051.     procedure secondassignment(var p : ptree);
  2052.  
  2053.       var
  2054.          opsize : topsize;
  2055.          {pushed,}withresult : boolean;
  2056.          otlabel,hlabel,oflabel : plabel;
  2057.          hregister : tregister;
  2058.          loc : tloc;
  2059.  
  2060.       begin
  2061.          otlabel:=truelabel;
  2062.          oflabel:=falselabel;
  2063.          getlabel(truelabel);
  2064.          getlabel(falselabel);
  2065.          withresult:=false;
  2066.          { calculate left sides }
  2067.          secondpass(p^.left);
  2068.          case p^.left^.location.loc of
  2069.             LOC_REFERENCE : begin
  2070.                               { in case left operator uses to register }
  2071.                               { but to few are free then LEA }
  2072.                               if (p^.left^.location.reference.base<>R_NO) and
  2073.                                  (p^.left^.location.reference.index<>R_NO) and
  2074.                                  (usablereg32<p^.right^.registers32) then
  2075.                                 begin
  2076.                                    del_reference(p^.left^.location.reference);
  2077.                                    hregister:=getregister32;
  2078.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(
  2079.                                      p^.left^.location.reference),
  2080.                                      hregister)));
  2081.                                    clear_reference(p^.left^.location.reference);
  2082.                                    p^.left^.location.reference.base:=hregister;
  2083.                                    p^.left^.location.reference.index:=R_NO;
  2084.                                 end;
  2085.                               loc:=LOC_REFERENCE;
  2086.                            end;
  2087.             LOC_CREGISTER:
  2088.               loc:=LOC_CREGISTER;
  2089.             LOC_MMXREGISTER:
  2090.               loc:=LOC_MMXREGISTER;
  2091.             LOC_CMMXREGISTER:
  2092.               loc:=LOC_CMMXREGISTER;
  2093.             else
  2094.                begin
  2095.                   Message(cg_e_illegal_expression);
  2096.                   exit;
  2097.                end;
  2098.          end;
  2099.          { lets try to optimize this (PM)             }
  2100.          { define a dest_loc that is the location      }
  2101.          { and a ptree to verify that it is the right }
  2102.          { place to insert it                         }
  2103. {$ifdef test_dest_loc}
  2104.          if (aktexprlevel<4) then
  2105.            begin
  2106.               dest_loc_known:=true;
  2107.               dest_loc:=p^.left^.location;
  2108.               dest_loc_tree:=p^.right;
  2109.            end;
  2110. {$endif test_dest_loc}
  2111.  
  2112.          if (p^.right^.treetype=realconstn) then
  2113.            begin
  2114.               if p^.left^.resulttype^.deftype=floatdef then
  2115.                 begin
  2116.                    case pfloatdef(p^.left^.resulttype)^.typ of
  2117.                      s32real : p^.right^.realtyp:=ait_real_32bit;
  2118.                      s64real : p^.right^.realtyp:=ait_real_64bit;
  2119.                      s80real : p^.right^.realtyp:=ait_real_extended;
  2120.                      { what about f32bit and s64bit }
  2121.                      end;
  2122.                 end;
  2123.            end;
  2124.          secondpass(p^.right);
  2125. {$ifdef test_dest_loc}
  2126.          dest_loc_known:=false;
  2127.          if in_dest_loc then
  2128.            begin
  2129.               truelabel:=otlabel;
  2130.               falselabel:=oflabel;
  2131.               in_dest_loc:=false;
  2132.               exit;
  2133.            end;
  2134. {$endif test_dest_loc}
  2135.          if p^.left^.resulttype^.deftype=stringdef then
  2136.            begin
  2137.              { we do not need destination anymore }
  2138.              del_reference(p^.left^.location.reference);
  2139.              { only source if withresult is set }
  2140.              if not(withresult) then
  2141.                del_reference(p^.right^.location.reference);
  2142.              loadstring(p);
  2143.              ungetiftemp(p^.right^.location.reference);
  2144.            end
  2145.         else case p^.right^.location.loc of
  2146.             LOC_REFERENCE,
  2147.             LOC_MEM : begin
  2148.                          { handle ordinal constants trimmed }
  2149.                          if (p^.right^.treetype in [ordconstn,fixconstn]) or
  2150.                             (loc=LOC_CREGISTER) then
  2151.                            begin
  2152.                               case p^.left^.resulttype^.size of
  2153.                                  1 : opsize:=S_B;
  2154.                                  2 : opsize:=S_W;
  2155.                                  4 : opsize:=S_L;
  2156.                               end;
  2157.                               if loc=LOC_CREGISTER then
  2158.                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
  2159.                                   newreference(p^.right^.location.reference),
  2160.                                   p^.left^.location.register)))
  2161.                               else
  2162.                                 exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
  2163.                                   p^.right^.location.reference.offset,
  2164.                                   newreference(p^.left^.location.reference))));
  2165.                               {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,opsize,
  2166.                                   p^.right^.location.reference.offset,
  2167.                                   p^.left^.location)));}
  2168.                            end
  2169.                          else
  2170.                            begin
  2171.                               concatcopy(p^.right^.location.reference,
  2172.                                 p^.left^.location.reference,p^.left^.resulttype^.size,
  2173.                                 withresult);
  2174.                               ungetiftemp(p^.right^.location.reference);
  2175.                            end;
  2176.                       end;
  2177. {$ifdef SUPPORT_MMX}
  2178.             LOC_CMMXREGISTER,
  2179.             LOC_MMXREGISTER:
  2180.               begin
  2181.                  if loc=LOC_CMMXREGISTER then
  2182.                    exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO,
  2183.                    p^.right^.location.register,p^.left^.location.register)))
  2184.                  else
  2185.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
  2186.                      p^.right^.location.register,newreference(p^.left^.location.reference))));
  2187.               end;
  2188. {$endif SUPPORT_MMX}
  2189.             LOC_REGISTER,
  2190.             LOC_CREGISTER : begin
  2191.                               case p^.right^.resulttype^.size of
  2192.                                  1 : opsize:=S_B;
  2193.                                  2 : opsize:=S_W;
  2194.                                  4 : opsize:=S_L;
  2195.                               end;
  2196.                               { simplified with op_reg_loc         }
  2197.                               if loc=LOC_CREGISTER then
  2198.                                 exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
  2199.                                   p^.right^.location.register,
  2200.                                   p^.left^.location.register)))
  2201.                               else
  2202.                                 exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
  2203.                                   p^.right^.location.register,
  2204.                                   newreference(p^.left^.location.reference))));
  2205.                               {exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize,
  2206.                                   p^.right^.location.register,
  2207.                                   p^.left^.location)));             }
  2208.  
  2209.                            end;
  2210.             LOC_FPU : begin
  2211.                               if loc<>LOC_REFERENCE then
  2212.                                 internalerror(10010)
  2213.                               else
  2214.                                 floatstore(pfloatdef(p^.left^.resulttype)^.typ,
  2215.                                   p^.left^.location.reference);
  2216.                            end;
  2217.             LOC_JUMP     : begin
  2218.                               getlabel(hlabel);
  2219.                               emitl(A_LABEL,truelabel);
  2220.                               if loc=LOC_CREGISTER then
  2221.                                 exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,
  2222.                                   1,p^.left^.location.register)))
  2223.                               else
  2224.                                 exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
  2225.                                   1,newreference(p^.left^.location.reference))));
  2226.                               {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,S_B,
  2227.                                   1,p^.left^.location)));}
  2228.                               emitl(A_JMP,hlabel);
  2229.                               emitl(A_LABEL,falselabel);
  2230.                               if loc=LOC_CREGISTER then
  2231.                                 exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,
  2232.                                   p^.left^.location.register,
  2233.                                   p^.left^.location.register)))
  2234.                               else
  2235.                                 exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
  2236.                                   0,newreference(p^.left^.location.reference))));
  2237.                               emitl(A_LABEL,hlabel);
  2238.                            end;
  2239.             LOC_FLAGS    : begin
  2240.                               if loc=LOC_CREGISTER then
  2241.                                 exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,
  2242.                                   p^.left^.location.register)))
  2243.                               else
  2244.                                 exprasmlist^.concat(new(pai386,op_ref(flag_2_set[p^.right^.location.resflags],S_NO,
  2245.                                   newreference(p^.left^.location.reference))));
  2246.                            end;
  2247.          end;
  2248.          truelabel:=otlabel;
  2249.          falselabel:=oflabel;
  2250.       end;
  2251.  
  2252.  
  2253.  
  2254.     { save the size of pushed parameter }
  2255.     var
  2256.        pushedparasize : longint;
  2257.  
  2258.     procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  2259.                 push_from_left_to_right : boolean);
  2260.  
  2261.       var
  2262.          size : longint;
  2263.          stackref : treference;
  2264.          otlabel,hlabel,oflabel : plabel;
  2265.  
  2266.  
  2267.          { temporary variables: }
  2268.          tempdeftype : tdeftype;
  2269.          tempreference : treference;
  2270.          r : preference;
  2271.          s : topsize;
  2272.          op : tasmop;
  2273.  
  2274.       begin
  2275.          { push from left to right if specified }
  2276.          if push_from_left_to_right and assigned(p^.right) then
  2277.            secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  2278.          otlabel:=truelabel;
  2279.          oflabel:=falselabel;
  2280.          getlabel(truelabel);
  2281.          getlabel(falselabel);
  2282.          secondpass(p^.left);
  2283.          { in codegen.handleread.. defcoll^.data is set to nil }
  2284.          if assigned(defcoll^.data) and
  2285.            (defcoll^.data^.deftype=formaldef) then
  2286.            begin
  2287.               { allow @var }
  2288.               if p^.left^.treetype=addrn then
  2289.                 begin
  2290.                    { allways a register }
  2291.                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  2292.                    ungetregister32(p^.left^.location.register);
  2293.                 end
  2294.               else
  2295.                 begin
  2296.                    if (p^.left^.location.loc<>LOC_REFERENCE) and
  2297.                       (p^.left^.location.loc<>LOC_MEM) then
  2298.                      Message(sym_e_type_mismatch)
  2299.                    else
  2300.                      begin
  2301.                         emitpushreferenceaddr(p^.left^.location.reference);
  2302.                         del_reference(p^.left^.location.reference);
  2303.                      end;
  2304.                 end;
  2305.               inc(pushedparasize,4);
  2306.            end
  2307.          { handle call by reference parameter }
  2308.          else if (defcoll^.paratyp=vs_var) then
  2309.            begin
  2310.               if (p^.left^.location.loc<>LOC_REFERENCE) then
  2311.                 Message(cg_e_var_must_be_reference);
  2312.               { open array ? }
  2313.               { defcoll^.data can be nil for read/write }
  2314.               if assigned(defcoll^.data) and
  2315.                 is_open_array(defcoll^.data) then
  2316.                 begin
  2317.                    { push high }
  2318.                    if is_open_array(p^.left^.resulttype) then
  2319.                      begin
  2320.                         new(r);
  2321.                         reset_reference(r^);
  2322.                         r^.base:=highframepointer;
  2323.                         r^.offset:=highoffset+4;
  2324.                         exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)));
  2325.                      end
  2326.                    else
  2327.                      push_int(parraydef(p^.left^.resulttype)^.highrange-
  2328.                               parraydef(p^.left^.resulttype)^.lowrange);
  2329.                    inc(pushedparasize,4);
  2330.                 end;
  2331.               emitpushreferenceaddr(p^.left^.location.reference);
  2332.               del_reference(p^.left^.location.reference);
  2333.               inc(pushedparasize,4);
  2334.            end
  2335.          else
  2336.            begin
  2337.               tempdeftype:=p^.resulttype^.deftype;
  2338.               if tempdeftype=filedef then
  2339.                Message(cg_e_file_must_call_by_reference);
  2340.               if (defcoll^.paratyp=vs_const) and
  2341.                  dont_copy_const_param(p^.resulttype) then
  2342.                 begin
  2343.                    emitpushreferenceaddr(p^.left^.location.reference);
  2344.                    del_reference(p^.left^.location.reference);
  2345.                    inc(pushedparasize,4);
  2346.                 end
  2347.               else
  2348.                 case p^.left^.location.loc of
  2349.                    LOC_REGISTER,
  2350.                    LOC_CREGISTER : begin
  2351.                                      case p^.left^.location.register of
  2352.                                         R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
  2353.                                         R_EDI,R_ESP,R_EBP :
  2354.                                           begin
  2355.                                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  2356.                                              inc(pushedparasize,4);
  2357.                                              ungetregister32(p^.left^.location.register);
  2358.                                           end;
  2359.                                         R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
  2360.                                           begin
  2361.                                               exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,p^.left^.location.register)));
  2362.                                               inc(pushedparasize,2);
  2363.                                               ungetregister32(reg16toreg32(p^.left^.location.register));
  2364.                                            end;
  2365.                                         R_AL,R_BL,R_CL,R_DL:
  2366.                                           begin
  2367.                                              { we must push always 16 bit }
  2368.                                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,
  2369.                                                reg8toreg16(p^.left^.location.register))));
  2370.                                              inc(pushedparasize,2);
  2371.                                              ungetregister32(reg8toreg32(p^.left^.location.register));
  2372.                                           end;
  2373.                                      end;
  2374.                                   end;
  2375.                        LOC_FPU : begin
  2376.                                         size:=pfloatdef(p^.left^.resulttype)^.size;
  2377.                                         inc(pushedparasize,size);
  2378.                                         exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  2379.                                         new(r);
  2380.                                         reset_reference(r^);
  2381.                                         r^.base:=R_ESP;
  2382.                                         floatstoreops(pfloatdef(p^.left^.resulttype)^.typ,op,s);
  2383.                                         exprasmlist^.concat(new(pai386,op_ref(op,s,r)));
  2384.                                      end;
  2385.                    LOC_REFERENCE,LOC_MEM :
  2386.                                       begin
  2387.                                           tempreference:=p^.left^.location.reference;
  2388.                                   del_reference(p^.left^.location.reference);
  2389.                                   case p^.resulttype^.deftype of
  2390.                                      orddef : begin
  2391.                                                    case porddef(p^.resulttype)^.typ of
  2392.                                                       s32bit,u32bit :
  2393.                                                         begin
  2394.                                                            emit_push_mem(tempreference);
  2395.                                                            inc(pushedparasize,4);
  2396.                                                         end;
  2397.                                                       s8bit,u8bit,uchar,bool8bit,s16bit,u16bit : begin
  2398.                                                           exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  2399.                                                             newreference(tempreference))));
  2400.                                                           inc(pushedparasize,2);
  2401.                                                       end;
  2402.                                                     end;
  2403.                                               end;
  2404.                                      floatdef : begin
  2405.                                                    case pfloatdef(p^.resulttype)^.typ of
  2406.                                                       f32bit,
  2407.                                                       s32real :
  2408.                                                         begin
  2409.                                                            emit_push_mem(tempreference);
  2410.                                                            inc(pushedparasize,4);
  2411.                                                         end;
  2412.                                                       s64real,
  2413.                                                       s64bit : begin
  2414.                                                                    inc(tempreference.offset,4);
  2415.                                                                    emit_push_mem(tempreference);
  2416.                                                                    dec(tempreference.offset,4);
  2417.                                                                    emit_push_mem(tempreference);
  2418.                                                                    inc(pushedparasize,8);
  2419.                                                                 end;
  2420.                                                       s80real : begin
  2421.                                                                    inc(tempreference.offset,6);
  2422.                                                                    emit_push_mem(tempreference);
  2423.                                                                    dec(tempreference.offset,4);
  2424.                                                                    emit_push_mem(tempreference);
  2425.                                                                    dec(tempreference.offset,2);
  2426.                                                                    exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  2427.                                                                      newreference(tempreference))));
  2428.                                                                    inc(pushedparasize,extended_size);
  2429.                                                                 end;
  2430.                                                    end;
  2431.                                                 end;
  2432.                                      pointerdef,procvardef,
  2433.                      enumdef,classrefdef:
  2434.                        begin
  2435.                                           emit_push_mem(tempreference);
  2436.                                           inc(pushedparasize,4);
  2437.                                        end;
  2438.                                      arraydef,recorddef,stringdef,setdef,objectdef :
  2439.                                                 begin
  2440.                                                    if ((p^.resulttype^.deftype=setdef) and
  2441.                                                      (psetdef(p^.resulttype)^.settype=smallset)) then
  2442.                                                      begin
  2443.                                                         emit_push_mem(tempreference);
  2444.                                                         inc(pushedparasize,4);
  2445.                                                      end
  2446.                                                    else
  2447.                                                      begin
  2448.                                                         size:=p^.resulttype^.size;
  2449.  
  2450.                                                         { Alignment }
  2451.                                                         {
  2452.                                                         if (size>=4) and ((size and 3)<>0) then
  2453.                                                           inc(size,4-(size and 3))
  2454.                                                         else if (size>=2) and ((size and 1)<>0) then
  2455.                                                           inc(size,2-(size and 1))
  2456.                                                         else
  2457.                                                         if size=1 then size:=2;
  2458.                                                         }
  2459.                                                         { create stack space }
  2460.                                                         exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  2461.                                                         inc(pushedparasize,size);
  2462.                                                         { create stack reference }
  2463.                                                         stackref.symbol := nil;
  2464.                                                         clear_reference(stackref);
  2465.                                                         stackref.base:=R_ESP;
  2466.                                                         { produce copy }
  2467.                                                         if p^.resulttype^.deftype=stringdef then
  2468.                                                           begin
  2469.                                                              copystring(stackref,p^.left^.location.reference,
  2470.                                                                pstringdef(p^.resulttype)^.len);
  2471.                                                           end
  2472.                                                         else
  2473.                                                           begin
  2474.                                                              concatcopy(p^.left^.location.reference,
  2475.                                                              stackref,p^.resulttype^.size,true);
  2476.                                                           end;
  2477.                                                      end;
  2478.                                                 end;
  2479.                                               else Message(cg_e_illegal_expression);
  2480.                                   end;
  2481.                                end;
  2482.                    LOC_JUMP:
  2483.                      begin
  2484.                         getlabel(hlabel);
  2485.                         inc(pushedparasize,2);
  2486.                         emitl(A_LABEL,truelabel);
  2487.                         exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,1)));
  2488.                         emitl(A_JMP,hlabel);
  2489.                         emitl(A_LABEL,falselabel);
  2490.                         exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,0)));
  2491.                         emitl(A_LABEL,hlabel);
  2492.                      end;
  2493.                    LOC_FLAGS:
  2494.                      begin
  2495.                         if not(R_EAX in unused) then
  2496.                           exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));
  2497.  
  2498.                         { clear full EAX is faster }
  2499.                         { but dont you set the equal flag ? }
  2500.                         {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  2501.                         exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
  2502.                           R_AL)));
  2503.                         exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
  2504.                         {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  2505.                         inc(pushedparasize,2);
  2506.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,R_AX)));
  2507.                         { this is also false !!!
  2508.                         if not(R_EAX in unused) then
  2509.                           exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));}
  2510.                         if not(R_EAX in unused) then
  2511.                           exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
  2512.                      end;
  2513. {$ifdef SUPPORT_MMX}
  2514.                    LOC_MMXREGISTER,
  2515.                    LOC_CMMXREGISTER:
  2516.                      begin
  2517.                         exprasmlist^.concat(new(pai386,op_const_reg(
  2518.                           A_SUB,S_L,8,R_ESP)));
  2519.                         new(r);
  2520.                         reset_reference(r^);
  2521.                         r^.base:=R_ESP;
  2522.                         exprasmlist^.concat(new(pai386,op_reg_ref(
  2523.                           A_MOVQ,S_NO,p^.left^.location.register,r)));
  2524.                      end;
  2525. {$endif SUPPORT_MMX}
  2526.                 end;
  2527.            end;
  2528.          truelabel:=otlabel;
  2529.          falselabel:=oflabel;
  2530.          { push from right to left }
  2531.          if not push_from_left_to_right and assigned(p^.right) then
  2532.            secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  2533.       end;
  2534.  
  2535.     procedure secondcalln(var p : ptree);
  2536.  
  2537.       var
  2538.          unusedregisters : tregisterset;
  2539.          pushed : tpushed;
  2540.          funcretref : treference;
  2541.          hregister : tregister;
  2542.          oldpushedparasize : longint;
  2543.          { true if ESI must be loaded again after the subroutine }
  2544.          loadesi : boolean;
  2545.          { true if a virtual method must be called directly }
  2546.          no_virtual_call : boolean;
  2547.          { true if we produce a con- or destrutor in a call }
  2548.          is_con_or_destructor : boolean;
  2549.          { true if a constructor is called again }
  2550.          extended_new : boolean;
  2551.          { adress returned from an I/O-error }
  2552.          iolabel : plabel;
  2553.          { lexlevel count }
  2554.          i : longint;
  2555.          { help reference pointer }
  2556.          r : preference;
  2557.          pp,params : ptree;
  2558.  
  2559.          { instruction for alignement correction }
  2560.          corr : pai386;
  2561.          { we must pop this size also after !! }
  2562.          must_pop : boolean;
  2563.          pop_size : longint;
  2564.  
  2565.       label
  2566.          dont_call;
  2567.  
  2568.       begin
  2569.          extended_new:=false;
  2570.          iolabel:=nil;
  2571.          loadesi:=true;
  2572.          no_virtual_call:=false;
  2573.          unusedregisters:=unused;
  2574.          if not assigned(p^.procdefinition) then
  2575.           exit;
  2576.          { only if no proc var }
  2577.          if not(assigned(p^.right)) then
  2578.            is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  2579.              or ((p^.procdefinition^.options and podestructor)<>0);
  2580.          { proc variables destroy all registers }
  2581.          if (p^.right=nil) and
  2582.             { virtual methods too }
  2583.             ((p^.procdefinition^.options and povirtualmethod)=0) then
  2584.            begin
  2585.               if ((p^.procdefinition^.options and poiocheck)<>0)
  2586.                 and (cs_iocheck in aktswitches) then
  2587.                 begin
  2588.                    getlabel(iolabel);
  2589.                    emitl(A_LABEL,iolabel);
  2590.                 end
  2591.               else iolabel:=nil;
  2592.  
  2593.               { save all used registers }
  2594.               pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  2595.  
  2596.               { give used registers through }
  2597.               usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  2598.            end
  2599.          else
  2600.            begin
  2601.               pushusedregisters(pushed,$ff);
  2602.               usedinproc:=$ff;
  2603.               { no IO check for methods and procedure variables }
  2604.               iolabel:=nil;
  2605.            end;
  2606.  
  2607.          { generate the code for the parameter and push them }
  2608.          oldpushedparasize:=pushedparasize;
  2609.          pushedparasize:=0;
  2610.          corr:=new(pai386,op_const_reg(A_SUB,S_L,0,R_ESP));
  2611.          exprasmlist^.concat(corr);
  2612.          if (p^.resulttype<>pdef(voiddef)) and
  2613.             ret_in_param(p^.resulttype) then
  2614.            begin
  2615.               funcretref.symbol:=nil;
  2616. {$ifdef test_dest_loc}
  2617.               if dest_loc_known and (dest_loc_tree=p) and
  2618.                  (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  2619.                 begin
  2620.                    funcretref:=dest_loc.reference;
  2621.                    if assigned(dest_loc.reference.symbol) then
  2622.                      funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  2623.                    in_dest_loc:=true;
  2624.                 end
  2625.               else
  2626. {$endif test_dest_loc}
  2627.                 gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  2628.            end;
  2629.          if assigned(p^.left) then
  2630.            begin
  2631.               pushedparasize:=0;
  2632.               { be found elsewhere }
  2633.               if assigned(p^.right) then
  2634.                 secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  2635.                   (p^.procdefinition^.options and poleftright)<>0)
  2636.               else
  2637.                 secondcallparan(p^.left,p^.procdefinition^.para1,
  2638.                   (p^.procdefinition^.options and poleftright)<>0);
  2639.            end;
  2640.          params:=p^.left;
  2641.          p^.left:=nil;
  2642.          if ret_in_param(p^.resulttype) then
  2643.            begin
  2644.               emitpushreferenceaddr(funcretref);
  2645.               inc(pushedparasize,4);
  2646.            end;
  2647.          { overloaded operator have no symtable }
  2648.          if (p^.right=nil) then
  2649.            begin
  2650.               { push self }
  2651.               if assigned(p^.symtable) and
  2652.                 (p^.symtable^.symtabletype=withsymtable) then
  2653.                 begin
  2654.                    { dirty trick to avoid the secondcall below }
  2655.                    p^.methodpointer:=genzeronode(callparan);
  2656.                    p^.methodpointer^.location.loc:=LOC_REGISTER;
  2657.                    p^.methodpointer^.location.register:=R_ESI;
  2658.                    { make a reference }
  2659.                    new(r);
  2660.                    reset_reference(r^);
  2661.                    r^.offset:=p^.symtable^.datasize;
  2662.                    r^.base:=procinfo.framepointer;
  2663.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  2664.                 end;
  2665.  
  2666.               { push self }
  2667.               if assigned(p^.symtable) and
  2668.                 ((p^.symtable^.symtabletype=objectsymtable) or
  2669.                 (p^.symtable^.symtabletype=withsymtable)) then
  2670.                 begin
  2671.                    if assigned(p^.methodpointer) then
  2672.                      begin
  2673.                         {
  2674.                         if p^.methodpointer^.resulttype=classrefdef then
  2675.                           begin
  2676.                               two possibilities:
  2677.                                1. constructor
  2678.                                2. class method
  2679.  
  2680.                           end
  2681.                         else }
  2682.                           begin
  2683.                              case p^.methodpointer^.treetype of
  2684.                                typen:
  2685.                                  begin
  2686.                                     { direct call to inherited method }
  2687.                                     if (p^.procdefinition^.options and poabstractmethod)<>0 then
  2688.                                       begin
  2689.                                          error(cg_e_cant_call_abstract_method);
  2690.                                          goto dont_call;
  2691.                                       end;
  2692.                                     { generate no virtual call }
  2693.                                     no_virtual_call:=true;
  2694.  
  2695.                                     if (p^.symtableprocentry^.properties and sp_static)<>0 then
  2696.                                       begin
  2697.                                          { well lets put the VMT address directly into ESI }
  2698.                                          { it is kind of dirty but that is the simplest    }
  2699.                                          { way to accept virtual static functions (PM)     }
  2700.                                          loadesi:=true;
  2701.                                          exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
  2702.                                            newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
  2703.                                          concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  2704.                                          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2705.                                       end
  2706.                                     else
  2707.                                       { this is a member call, so ESI isn't modfied }
  2708.                                       loadesi:=false;
  2709.                                     if not(is_con_or_destructor and
  2710.                                       pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  2711.                                         assigned(aktprocsym) and
  2712.                                         ((aktprocsym^.definition^.options and
  2713.                                         (poconstructor or podestructor))<>0)) then
  2714.                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2715.                                     { if an inherited con- or destructor should be  }
  2716.                                     { called in a con- or destructor then a warning }
  2717.                                     { will be made                                  }
  2718.                                     { con- and destructors need a pointer to the vmt }
  2719.                                     if is_con_or_destructor and
  2720.                                     not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  2721.                                     assigned(aktprocsym) then
  2722.                                       begin
  2723.                                          if not ((aktprocsym^.definition^.options
  2724.                                            and (poconstructor or podestructor))<>0) then
  2725.  
  2726.                                           Message(cg_w_member_cd_call_from_method);
  2727.                                       end;
  2728.                                     if is_con_or_destructor then
  2729.                                       push_int(0)
  2730.                                  end;
  2731.                                hnewn:
  2732.                                  begin
  2733.                                     { extended syntax of new }
  2734.                                     { ESI must be zero }
  2735.                                     exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  2736.                                     exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2737.                                     { insert the vmt }
  2738.                                     exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  2739.                                     newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  2740.                                     concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  2741.                                     extended_new:=true;
  2742.                                  end;
  2743.                                hdisposen:
  2744.                                  begin
  2745.                                     secondpass(p^.methodpointer);
  2746.  
  2747.                                     { destructor with extended syntax called from dispose }
  2748.                                     { hdisposen always deliver LOC_REFERENCE              }
  2749.                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  2750.                                       newreference(p^.methodpointer^.location.reference),R_ESI)));
  2751.                                     del_reference(p^.methodpointer^.location.reference);
  2752.                                     exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2753.                                     exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  2754.                                     newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  2755.                                     concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  2756.                                  end;
  2757.                                else
  2758.                                  begin
  2759.                                     { call to an instance member }
  2760.                                     if (p^.symtable^.symtabletype<>withsymtable) then
  2761.                                       begin
  2762.                                          secondpass(p^.methodpointer);
  2763.                                          case p^.methodpointer^.location.loc of
  2764.                                             LOC_REGISTER:
  2765.                                               begin
  2766.                                                  ungetregister32(p^.methodpointer^.location.register);
  2767.                                                  emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  2768.                                               end;
  2769.                                             else
  2770.                                               begin
  2771.                                                  if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  2772.                                                    pobjectdef(p^.methodpointer^.resulttype)^.isclass then
  2773.                                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  2774.                                                      newreference(p^.methodpointer^.location.reference),R_ESI)))
  2775.                                                  else
  2776.                                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  2777.                                                      newreference(p^.methodpointer^.location.reference),R_ESI)));
  2778.                                                  del_reference(p^.methodpointer^.location.reference);
  2779.                                               end;
  2780.                                          end;
  2781.                                       end;
  2782.                                     { when calling a class method, we have
  2783.                                       to load ESI with the VMT !
  2784.                                       But that's wrong, if we call a class method via self
  2785.                                     }
  2786.                                     if ((p^.procdefinition^.options and poclassmethod)<>0)
  2787.                                        and not(p^.methodpointer^.treetype=selfn) then
  2788.                                       begin
  2789.                                          { class method needs current VMT }
  2790.                                          new(r);
  2791.                                          reset_reference(r^);
  2792.                                          r^.base:=R_ESI;
  2793.                                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  2794.                                       end;
  2795.  
  2796.                                     exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2797.                                     if is_con_or_destructor then
  2798.                                       begin
  2799.                                          { classes don't get a VMT pointer pushed }
  2800.                                          if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  2801.                                            not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  2802.                                            begin
  2803.                                               if ((p^.procdefinition^.options and poconstructor)<>0) then
  2804.                                                 begin
  2805.                                                    { it's no bad idea, to insert the VMT }
  2806.                                                    exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  2807.                                                      newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  2808.                                                      0))));
  2809.                                                    concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  2810.                                                      EXT_NEAR);
  2811.                                                 end
  2812.                                               { destructors haven't to dispose the instance, if this is }
  2813.                                               { a direct call                                           }
  2814.                                               else
  2815.                                                 push_int(0);
  2816.                                            end;
  2817.                                       end;
  2818.                                  end;
  2819.                              end;
  2820.                           end;
  2821.                      end
  2822.                    else
  2823.                      begin
  2824.                         if ((p^.procdefinition^.options and poclassmethod)<>0) and
  2825.                           not(
  2826.                             assigned(aktprocsym) and
  2827.                             ((aktprocsym^.definition^.options and poclassmethod)<>0)
  2828.                           ) then
  2829.                           begin
  2830.                              { class method needs current VMT }
  2831.                              new(r);
  2832.                              reset_reference(r^);
  2833.                              r^.base:=R_ESI;
  2834.                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  2835.                           end
  2836.                         else
  2837.                           begin
  2838.                              { member call, ESI isn't modified }
  2839.                              loadesi:=false;
  2840.                           end;
  2841.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2842.                         { but a con- or destructor here would probably almost }
  2843.                         { always be placed wrong }
  2844.                         if is_con_or_destructor then
  2845.                           begin
  2846.                              Message(cg_w_member_cd_call_from_method);
  2847.                              push_int(0);
  2848.                           end;
  2849.                      end;
  2850.                 end;
  2851.  
  2852.               { push base pointer ?}
  2853.               if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
  2854.                 ((p^.procdefinition^.parast^.symtablelevel)>2) then
  2855.                 begin
  2856.                    { if we call a nested function in a method, we must      }
  2857.                    { push also SELF!                                        }
  2858.                    { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  2859.                    { access                                                 }
  2860.                    {
  2861.                      begin
  2862.                         loadesi:=false;
  2863.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  2864.                      end;
  2865.                    }
  2866.                    if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  2867.                      begin
  2868.                         new(r);
  2869.                         reset_reference(r^);
  2870.                         r^.offset:=procinfo.framepointer_offset;
  2871.                         r^.base:=procinfo.framepointer;
  2872.                         exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  2873.                      end
  2874.                      { this is only true if the difference is one !!
  2875.                        but it cannot be more !! }
  2876.                    else if (lexlevel=p^.procdefinition^.parast^.symtablelevel-1) then
  2877.                      begin
  2878.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  2879.                      end
  2880.                    else if (lexlevel>p^.procdefinition^.parast^.symtablelevel) then
  2881.                      begin
  2882.                         hregister:=getregister32;
  2883.                         new(r);
  2884.                         reset_reference(r^);
  2885.                         r^.offset:=procinfo.framepointer_offset;
  2886.                         r^.base:=procinfo.framepointer;
  2887.                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  2888.                         for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  2889.                           begin
  2890.                              new(r);
  2891.                              reset_reference(r^);
  2892.                              {we should get the correct frame_pointer_offset at each level
  2893.                              how can we do this !!! }
  2894.                              r^.offset:=procinfo.framepointer_offset;
  2895.                              r^.base:=hregister;
  2896.                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  2897.                           end;
  2898.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  2899.                         ungetregister32(hregister);
  2900.                      end
  2901.                    else
  2902.                      internalerror(25000);
  2903.                 end;
  2904.  
  2905.               { exported methods should be never called direct }
  2906.               if (p^.procdefinition^.options and poexports)<>0 then
  2907.                 Message(cg_e_dont_call_exported_direct);
  2908.  
  2909.               if (pushedparasize mod 4)<>0 then
  2910.                 begin
  2911.                    corr^.op1:=pointer(4-(pushedparasize mod 4));
  2912.                    must_pop:=true;
  2913.                    pop_size:=4-(pushedparasize mod 4);
  2914.                 end
  2915.               else
  2916.                 begin
  2917.                    exprasmlist^.remove(corr);
  2918.                    must_pop:=false;
  2919.                    pop_size:=0;
  2920.                 end;
  2921.  
  2922.               if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  2923.                  not(no_virtual_call) then
  2924.                 begin
  2925.                    { static functions contain the vmt_address in ESI }
  2926.                    { also class methods                              }
  2927.                    if assigned(aktprocsym) then
  2928.                      begin
  2929.                        if ((aktprocsym^.properties and sp_static)<>0) or
  2930.                         ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  2931.                         ((p^.procdefinition^.options and postaticmethod)<>0) or
  2932.                         { ESI is loaded earlier }
  2933.                         ((p^.procdefinition^.options and poclassmethod)<>0)then
  2934.                          begin
  2935.                             new(r);
  2936.                             reset_reference(r^);
  2937.                             r^.base:=R_ESI;
  2938.                          end
  2939.                        else
  2940.                          begin
  2941.                             new(r);
  2942.                             reset_reference(r^);
  2943.                             r^.base:=R_ESI;
  2944.                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  2945.                             new(r);
  2946.                             reset_reference(r^);
  2947.                             r^.base:=R_EDI;
  2948.                          end;
  2949.                      end
  2950.                    else
  2951.                      begin
  2952.                        new(r);
  2953.                        reset_reference(r^);
  2954.                        r^.base:=R_ESI;
  2955.                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  2956.                        new(r);
  2957.                        reset_reference(r^);
  2958.                        r^.base:=R_EDI;
  2959.                      end;
  2960.                    if p^.procdefinition^.extnumber=-1 then
  2961.                         internalerror($Da);
  2962.                    r^.offset:=p^.procdefinition^.extnumber*4+12;
  2963.                    if (cs_rangechecking in aktswitches) then
  2964.                      begin
  2965.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  2966.                         emitcall('CHECK_OBJECT',true);
  2967.                      end;
  2968.                    exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  2969.                 end
  2970.               else
  2971.                 emitcall(p^.procdefinition^.mangledname,
  2972.                   p^.symtableproc^.symtabletype=unitsymtable);
  2973.               if ((p^.procdefinition^.options and poclearstack)<>0) then
  2974.                 begin
  2975.                    { consider the alignment with the rest (PM) }
  2976.                    pushedparasize:=pushedparasize+pop_size;
  2977.                    must_pop:=false;
  2978.                    if pushedparasize=4 then
  2979.                      { better than an add on all processors }
  2980.                      exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  2981.                    { the pentium has two pipes and pop reg is pairable }
  2982.                    { but the registers must be different!              }
  2983.                    else if (pushedparasize=8) and
  2984.                      not(cs_littlesize in aktswitches) and
  2985.                      (opt_processors=pentium) and
  2986.                      (procinfo._class=nil) then
  2987.                        begin
  2988.                           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  2989.                           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  2990.                        end
  2991.                    else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  2992.                 end;
  2993.            end
  2994.          else
  2995.            begin
  2996.               if (pushedparasize mod 4)<>0 then
  2997.                 begin
  2998.                    corr^.op1:=pointer(4-(pushedparasize mod 4));
  2999.                    must_pop:=true;
  3000.                    pop_size:=4-(pushedparasize mod 4);
  3001.                 end
  3002.               else
  3003.                 begin
  3004.                    exprasmlist^.remove(corr);
  3005.                    must_pop:=false;
  3006.                    pop_size:=0;
  3007.                 end;
  3008.  
  3009.               secondpass(p^.right);
  3010.               case p^.right^.location.loc of
  3011.                  LOC_REGISTER,LOC_CREGISTER:
  3012.                     begin
  3013.                         exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  3014.                         ungetregister32(p^.right^.location.register);
  3015.                     end
  3016.                  else
  3017.                     exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  3018.                     del_reference(p^.right^.location.reference);
  3019.               end;
  3020.  
  3021.  
  3022.              end;
  3023.       dont_call:
  3024.          pushedparasize:=oldpushedparasize;
  3025.          unused:=unusedregisters;
  3026.  
  3027.          { handle function results }
  3028.          if p^.resulttype<>pdef(voiddef) then
  3029.            begin
  3030.  
  3031.                  { a contructor could be a function with boolean result }
  3032.               if (p^.right=nil) and
  3033.                  ((p^.procdefinition^.options and poconstructor)<>0) and
  3034.                  { quick'n'dirty check if it is a class or an object }
  3035.                  (p^.resulttype^.deftype=orddef) then
  3036.                 begin
  3037.                    p^.location.loc:=LOC_FLAGS;
  3038.                    p^.location.resflags:=F_NE;
  3039.                    if extended_new then
  3040.                      begin
  3041. {$ifdef test_dest_loc}
  3042.                         if dest_loc_known and (dest_loc_tree=p) then
  3043.                           mov_reg_to_dest(p,S_L,R_EAX)
  3044.                         else
  3045. {$endif test_dest_loc}
  3046.                           begin
  3047.                              hregister:=getregister32;
  3048.                              emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  3049.                              p^.location.register:=hregister;
  3050.                           end;
  3051.                      end;
  3052.                 end
  3053.               { structed results are easy to handle.... }
  3054.               else if ret_in_param(p^.resulttype) then
  3055.                 begin
  3056.                    p^.location.loc:=LOC_MEM;
  3057.                    stringdispose(p^.location.reference.symbol);
  3058.                    p^.location.reference:=funcretref;
  3059.                     end
  3060.                  else
  3061.                     begin
  3062.                        if (p^.resulttype^.deftype=orddef) then
  3063.                           begin
  3064.                              p^.location.loc:=LOC_REGISTER;
  3065.                              case porddef(p^.resulttype)^.typ of
  3066.                                 s32bit,u32bit :
  3067.                                   begin
  3068. {$ifdef test_dest_loc}
  3069.                                      if dest_loc_known and (dest_loc_tree=p) then
  3070.                                        mov_reg_to_dest(p,S_L,R_EAX)
  3071.                                      else
  3072. {$endif test_dest_loc}
  3073.                                        begin
  3074.                                           hregister:=getregister32;
  3075.                                           emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  3076.                                           p^.location.register:=hregister;
  3077.                                        end;
  3078.                                   end;
  3079.                                 uchar,u8bit,bool8bit,s8bit :
  3080.                                   begin
  3081. {$ifdef test_dest_loc}
  3082.                                      if dest_loc_known and (dest_loc_tree=p) then
  3083.                                        mov_reg_to_dest(p,S_B,R_AL)
  3084.                                      else
  3085. {$endif test_dest_loc}
  3086.                                        begin
  3087.                                           hregister:=getregister32;
  3088.                                           emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  3089.                                           p^.location.register:=reg32toreg8(hregister);
  3090.                                        end;
  3091.                                   end;
  3092.                                 s16bit,u16bit :
  3093.                                   begin
  3094. {$ifdef test_dest_loc}
  3095.                                      if dest_loc_known and (dest_loc_tree=p) then
  3096.                                        mov_reg_to_dest(p,S_W,R_AX)
  3097.                                      else
  3098. {$endif test_dest_loc}
  3099.                                        begin
  3100.                                           hregister:=getregister32;
  3101.                                           emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  3102.                                           p^.location.register:=reg32toreg16(hregister);
  3103.                                        end;
  3104.                                   end;
  3105.                              else internalerror(7);
  3106.                               end
  3107.  
  3108.                           end
  3109.                        else if (p^.resulttype^.deftype=floatdef) then
  3110.                            case pfloatdef(p^.resulttype)^.typ of
  3111.                                  f32bit : begin
  3112.                                              p^.location.loc:=LOC_REGISTER;
  3113. {$ifdef test_dest_loc}
  3114.                                              if dest_loc_known and (dest_loc_tree=p) then
  3115.                                                mov_reg_to_dest(p,S_L,R_EAX)
  3116.                                              else
  3117. {$endif test_dest_loc}
  3118.                                                begin
  3119.                                                   hregister:=getregister32;
  3120.                                                   emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  3121.                                                   p^.location.register:=hregister;
  3122.                                                end;
  3123.                                           end;
  3124.                                  else
  3125.                                      p^.location.loc:=LOC_FPU;
  3126.                            end
  3127.                        else
  3128.                           begin
  3129.                               p^.location.loc:=LOC_REGISTER;
  3130. {$ifdef test_dest_loc}
  3131.                               if dest_loc_known and (dest_loc_tree=p) then
  3132.                                 mov_reg_to_dest(p,S_L,R_EAX)
  3133.                               else
  3134. {$endif test_dest_loc}
  3135.                                 begin
  3136.                                     hregister:=getregister32;
  3137.                                     emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  3138.                                     p^.location.register:=hregister;
  3139.                                 end;
  3140.                           end;
  3141.                 end;
  3142.            end;
  3143.  
  3144.          { perhaps i/o check ? }
  3145.          if iolabel<>nil then
  3146.            begin
  3147.               exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  3148.               { this was wrong, probably an error due to diff3
  3149.                 emitcall(p^.procdefinition^.mangledname);}
  3150.               emitcall('IOCHECK',true);
  3151.            end;
  3152.          { this should be optimized (PM) }
  3153.          if must_pop then
  3154.            exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  3155.          { restore registers }
  3156.          popusedregisters(pushed);
  3157.  
  3158.          { at last, restore instance pointer (SELF) }
  3159.          if loadesi then
  3160.            maybe_loadesi;
  3161.          pp:=params;
  3162.          while assigned(pp) do
  3163.            begin
  3164.               if assigned(pp^.left) then
  3165.                 if (pp^.left^.location.loc=LOC_REFERENCE) or
  3166.                   (pp^.left^.location.loc=LOC_MEM) then
  3167.                   ungetiftemp(pp^.left^.location.reference);
  3168.               pp:=pp^.right;
  3169.            end;
  3170.          disposetree(params);
  3171.       end;
  3172.  
  3173.     { reverts the parameter list }
  3174.     var nb_para : integer;
  3175.  
  3176.     function reversparameter(p : ptree) : ptree;
  3177.  
  3178.        var
  3179.          hp1,hp2 : ptree;
  3180.  
  3181.       begin
  3182.          hp1:=nil;
  3183.          nb_para := 0;
  3184.          while assigned(p) do
  3185.            begin
  3186.               { pull out }
  3187.               hp2:=p;
  3188.               p:=p^.right;
  3189.               inc(nb_para);
  3190.               { pull in }
  3191.               hp2^.right:=hp1;
  3192.               hp1:=hp2;
  3193.            end;
  3194.          reversparameter:=hp1;
  3195.        end;
  3196.  
  3197.     procedure secondinline(var p : ptree);
  3198.      const     in2size:array[in_inc_byte..in_dec_dword] of Topsize=
  3199.                          (S_B,S_W,S_L,S_B,S_W,S_L);
  3200.                in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
  3201.                          (A_INC,A_INC,A_INC,A_DEC,A_DEC,A_DEC);
  3202.                ad2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
  3203.                          (A_ADD,A_ADD,A_ADD,A_SUB,A_SUB,A_SUB);
  3204.             { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
  3205.             float_name: array[tfloattype] of string[8]=
  3206.                 ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
  3207.        var
  3208.          aktfile : treference;
  3209.          ft : tfiletype;
  3210.          opsize : topsize;
  3211.          asmop : tasmop;
  3212.          pushed : tpushed;
  3213.          dummycoll : tdefcoll;
  3214.  
  3215.       { produces code for READ(LN) and WRITE(LN) }
  3216.  
  3217.       procedure handlereadwrite(doread,callwriteln : boolean);
  3218.  
  3219.         procedure loadstream;
  3220.  
  3221.           const     io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
  3222.           var     r : preference;
  3223.  
  3224.             begin
  3225.                  new(r);
  3226.                  reset_reference(r^);
  3227.                  r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
  3228.                  if assem_need_external_list and
  3229.                    not (cs_compilesystem in aktswitches) then
  3230.                  concat_external(r^.symbol^,EXT_NEAR);
  3231.  
  3232.                  exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
  3233.             end;
  3234.  
  3235.         var
  3236.              node,hp : ptree;
  3237.             typedtyp,pararesult : pdef;
  3238.            doflush,has_length : boolean;
  3239.            dummycoll : tdefcoll;
  3240.            iolabel : plabel;
  3241.            npara : longint;
  3242.  
  3243.         begin
  3244.            { I/O check }
  3245.            if cs_iocheck in aktswitches then
  3246.                 begin
  3247.                 getlabel(iolabel);
  3248.                 emitl(A_LABEL,iolabel);
  3249.              end
  3250.            else iolabel:=nil;
  3251.            { no automatic call from flush }
  3252.            doflush:=false;
  3253.            { for write of real with the length specified }
  3254.            has_length:=false;
  3255.            hp:=nil;
  3256.            { reserve temporary pointer to data variable }
  3257.              aktfile.symbol:=nil;
  3258.            gettempofsizereference(4,aktfile);
  3259.            { first state text data }
  3260.            ft:=ft_text;
  3261.            { and state a parameter ? }
  3262.            if p^.left=nil then
  3263.              begin
  3264.                 { state screen address}
  3265.                 doflush:=true;
  3266.                 { the following instructions are for "writeln;" }
  3267.                 loadstream;
  3268.                 { save @Dateivarible in temporary variable }
  3269.                 exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  3270.              end
  3271.            else
  3272.              begin
  3273.                 { revers paramters }
  3274.                 node:=reversparameter(p^.left);
  3275.  
  3276.                 p^.left := node;
  3277.                 npara := nb_para;
  3278.                 { calculate data variable }
  3279.                 { is first parameter a file type ? }
  3280.                 if node^.left^.resulttype^.deftype=filedef then
  3281.                   begin
  3282.                      ft:=pfiledef(node^.left^.resulttype)^.filetype;
  3283.                      if ft=ft_typed then
  3284.                        typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  3285.                      secondpass(node^.left);
  3286.                      if codegenerror then
  3287.                        exit;
  3288.  
  3289.                      { save reference in temporary variables }                     { reference in tempor„re Variable retten }
  3290.                      if node^.left^.location.loc<>LOC_REFERENCE then
  3291.                        begin
  3292.                           Message(cg_e_illegal_expression);
  3293.                           exit;
  3294.                        end;
  3295.  
  3296.                      exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
  3297.  
  3298.                      { skip to the next parameter }
  3299.                      node:=node^.right;
  3300.                   end
  3301.                 else
  3302.                   begin
  3303.                      { if we write to stdout/in then flush after the write(ln) }
  3304.                      doflush:=true;
  3305.                      loadstream;
  3306.                   end;
  3307.  
  3308.                     { save @Dateivarible in temporary variable }
  3309.                 exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  3310.                 if doread then
  3311.                   { parameter by READ gives call by reference }
  3312.                   dummycoll.paratyp:=vs_var
  3313.                 { an WRITE Call by "Const" }
  3314.                 else dummycoll.paratyp:=vs_const;
  3315.  
  3316.                 { because of secondcallparan, which otherwise attaches }
  3317.                 if ft=ft_typed then
  3318.                   begin
  3319.                      { this is to avoid copy of simple const parameters }
  3320.                      dummycoll.data:=new(pformaldef,init);
  3321.                   end
  3322.                 else
  3323.                   { I think, this isn't a good solution (FK) }
  3324.                   dummycoll.data:=nil;
  3325.  
  3326.                 while assigned(node) do
  3327.                   begin
  3328.                      pushusedregisters(pushed,$ff);
  3329.                      hp:=node;
  3330.                      node:=node^.right;
  3331.                      hp^.right:=nil;
  3332.                      if hp^.is_colon_para then
  3333.                        Message(parser_e_illegal_colon_qualifier);
  3334.                      if ft=ft_typed then
  3335.                        never_copy_const_param:=true;
  3336.                      secondcallparan(hp,@dummycoll,false);
  3337.                      if ft=ft_typed then
  3338.                        never_copy_const_param:=false;
  3339.                      hp^.right:=node;
  3340.                           if codegenerror then
  3341.                        exit;
  3342.  
  3343.                      emit_push_mem(aktfile);
  3344.                      if (ft=ft_typed) then
  3345.                        begin
  3346.                           { OK let's try this }
  3347.                           { first we must only allow the right type }
  3348.                             { we have to call blockread or blockwrite }
  3349.                                    { but the real problem is that            }
  3350.                             { reset and rewrite should have set       }
  3351.                             { the type size                           }
  3352.                                    { as recordsize for that file !!!!        }
  3353.                             { how can we make that                    }
  3354.                             { I think that is only possible by adding }
  3355.                             { reset and rewrite to the inline list a call        }
  3356.                                    { allways read only one record by element }
  3357.                             push_int(typedtyp^.size);
  3358.                             if doread then
  3359.                               emitcall('TYPED_READ',true)
  3360.                             else
  3361.                               emitcall('TYPED_WRITE',true)
  3362.                           {!!!!!!!}
  3363.                        end
  3364.                      else
  3365.                        begin
  3366.                           { save current position }
  3367.                           pararesult:=hp^.left^.resulttype;
  3368.                           { handle possible field width  }
  3369.                           { of course only for write(ln) }
  3370.                           if not doread then
  3371.                                begin
  3372.                                { handle total width parameter }
  3373.                                if assigned(node) and node^.is_colon_para then
  3374.                                  begin
  3375.                                     hp:=node;
  3376.                                     node:=node^.right;
  3377.                                     hp^.right:=nil;
  3378.                                     secondcallparan(hp,@dummycoll,false);
  3379.                                     hp^.right:=node;
  3380.                                     if codegenerror then
  3381.                                       exit;
  3382.                                     has_length:=true;
  3383.                                  end
  3384.                                else
  3385.                                  if pararesult^.deftype<>floatdef then
  3386.                                    push_int(0)
  3387.                                  else
  3388.                                   push_int(-32767);
  3389.                               { a second colon para for a float ? }
  3390.                               if assigned(node) and node^.is_colon_para then
  3391.                                 begin
  3392.                                     hp:=node;
  3393.                                     node:=node^.right;
  3394.                                     hp^.right:=nil;
  3395.                                     secondcallparan(hp,@dummycoll,false);
  3396.                                     hp^.right:=node;
  3397.                                     if pararesult^.deftype<>floatdef then
  3398.                                       Message(parser_e_illegal_colon_qualifier);
  3399.                                     if codegenerror then
  3400.                                       exit;
  3401.                                 end
  3402.                               else
  3403.                                 begin
  3404.                                 if pararesult^.deftype=floatdef then
  3405.                                     push_int(-1);
  3406.                                 end
  3407.                               end;
  3408.                           case pararesult^.deftype of
  3409.                              stringdef:
  3410.                                begin
  3411.                                   if doread then
  3412.                                     emitcall('READ_TEXT_STRING',true)
  3413.                                   else
  3414.                                     begin
  3415.                                       emitcall('WRITE_TEXT_STRING',true);
  3416.                                       {ungetiftemp(hp^.left^.location.reference);}
  3417.                                     end;
  3418.                                end;
  3419.                                     pointerdef : begin
  3420.                                                         if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
  3421.                                                           begin
  3422.                                                               if doread then
  3423.                                                                  emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
  3424.                                                               else
  3425.                                                                  emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
  3426.                                                           end
  3427.                                                         else
  3428.                                                          Message(parser_e_illegal_parameter_list);
  3429.                                                     end;
  3430.                                     arraydef : begin
  3431.                                                      if (parraydef(pararesult)^.lowrange=0)
  3432.                                                         and is_equal(parraydef(pararesult)^.definition,cchardef) then
  3433.                                                         begin
  3434.                                                             if doread then
  3435.                                                                  emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
  3436.                                                             else
  3437.                                                                  emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
  3438.                                                         end
  3439.                                                      else
  3440.                                                       Message(parser_e_illegal_parameter_list);
  3441.                                                   end;
  3442.  
  3443.                              floatdef:
  3444.                                begin
  3445.                                   if doread then
  3446.                                     emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
  3447.                                   else
  3448.                                     emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
  3449.                                end;
  3450.                                     orddef : begin
  3451.                                                      case porddef(pararesult)^.typ of
  3452.                                                          u8bit : if doread then
  3453.                                                                        emitcall('READ_TEXT_BYTE',true);
  3454.                                                          s8bit : if doread then
  3455.                                                                        emitcall('READ_TEXT_SHORTINT',true);
  3456.                                                          u16bit : if doread then
  3457.                                                                        emitcall('READ_TEXT_WORD',true);
  3458.                                                          s16bit : if doread then
  3459.                                                                        emitcall('READ_TEXT_INTEGER',true);
  3460.                                                          s32bit : if doread then
  3461.                                                                        emitcall('READ_TEXT_LONGINT',true)
  3462.                                                                     else
  3463.                                                                        emitcall('WRITE_TEXT_LONGINT',true);
  3464.                                                          u32bit : if doread then
  3465.                                                                        emitcall('READ_TEXT_CARDINAL',true)
  3466.                                                                     else
  3467.                                                                        emitcall('WRITE_TEXT_CARDINAL',true);
  3468.                                                          uchar : if doread then
  3469.                                                                        emitcall('READ_TEXT_CHAR',true)
  3470.                                                                     else
  3471.                                                                        emitcall('WRITE_TEXT_CHAR',true);
  3472.                                                          bool8bit : if  doread then
  3473.                                                                        { emitcall('READ_TEXT_BOOLEAN',true) }
  3474.                                                                        Message(parser_e_illegal_parameter_list)
  3475.                                                                     else
  3476.                                                                        emitcall('WRITE_TEXT_BOOLEAN',true);
  3477.                                                          else Message(parser_e_illegal_parameter_list);
  3478.                                                          end;
  3479.                                                      end;
  3480.                                     else Message(parser_e_illegal_parameter_list);
  3481.                                 end;
  3482.                             end;
  3483.                           { load ESI in methods again }
  3484.                           popusedregisters(pushed);
  3485.                           maybe_loadesi;
  3486.                   end;
  3487.              end;
  3488.            if callwriteln then
  3489.              begin
  3490.                 pushusedregisters(pushed,$ff);
  3491.                 emit_push_mem(aktfile);
  3492.                 { pushexceptlabel; }
  3493.                 if ft<>ft_text then
  3494.                   Message(parser_e_illegal_parameter_list)                                    ;
  3495.                 emitcall('WRITELN_TEXT',true);
  3496.                 popusedregisters(pushed);
  3497.                 maybe_loadesi;
  3498.              end;
  3499.            if doflush and not(doread) then
  3500.              begin
  3501.                 pushusedregisters(pushed,$ff);
  3502.                 { pushexceptlabel; }
  3503.                 emitcall('FLUSH_STDOUT',true);
  3504.                 popusedregisters(pushed);
  3505.                 maybe_loadesi;
  3506.              end;
  3507.            if iolabel<>nil then
  3508.              begin
  3509.                 { registers are saved in the procedure }
  3510.                 exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  3511.                 emitcall('IOCHECK',true);
  3512.              end;
  3513.            ungetiftemp(aktfile);
  3514.            if assigned(p^.left) then
  3515.              begin
  3516.                 p^.left:=reversparameter(p^.left);
  3517.                     if npara<>nb_para then
  3518.                      Message(cg_f_internal_error_in_secondinline);
  3519.                     hp:=p^.left;
  3520.                     while assigned(hp) do
  3521.                   begin
  3522.                      if assigned(hp^.left) then
  3523.                        if (hp^.left^.location.loc=LOC_REFERENCE) or
  3524.                          (hp^.left^.location.loc=LOC_MEM) then
  3525.                          ungetiftemp(hp^.left^.location.reference);
  3526.                      hp:=hp^.right;
  3527.                   end;
  3528.             end;
  3529.         end;
  3530.  
  3531.       procedure handle_str;
  3532.  
  3533.         var
  3534.            hp,node,lentree,paratree : ptree;
  3535.            dummycoll : tdefcoll;
  3536.            is_real,has_length : boolean;
  3537.            real_type : byte;
  3538.  
  3539.           begin
  3540.            pushusedregisters(pushed,$ff);
  3541.            node:=p^.left;
  3542.            is_real:=false;
  3543.            has_length:=false;
  3544.            while assigned(node^.right) do node:=node^.right;
  3545.            { if a real parameter somewhere then call REALSTR }
  3546.            if (node^.left^.resulttype^.deftype=floatdef) then
  3547.              is_real:=true;
  3548.  
  3549.            node:=p^.left;
  3550.            { we have at least two args }
  3551.            { with at max 2 colon_para in between }
  3552.  
  3553.            { first arg longint or float }
  3554.            hp:=node;
  3555.            node:=node^.right;
  3556.            hp^.right:=nil;
  3557.            dummycoll.data:=hp^.resulttype;
  3558.            { string arg }
  3559.  
  3560.            dummycoll.paratyp:=vs_var;
  3561.            secondcallparan(hp,@dummycoll,false);
  3562.            if codegenerror then
  3563.              exit;
  3564.  
  3565.            dummycoll.paratyp:=vs_const;
  3566.            { second arg }
  3567.            hp:=node;
  3568.            node:=node^.right;
  3569.            hp^.right:=nil;
  3570.            { frac  para }
  3571.            if hp^.is_colon_para and assigned(node) and
  3572.               node^.is_colon_para then
  3573.              begin
  3574.                 dummycoll.data:=hp^.resulttype;
  3575.                 secondcallparan(hp,@dummycoll,false);
  3576.                 if codegenerror then
  3577.                   exit;
  3578.                 hp:=node;
  3579.                 node:=node^.right;
  3580.                 hp^.right:=nil;
  3581.                 has_length:=true;
  3582.              end
  3583.            else
  3584.              if is_real then
  3585.              push_int(-1);
  3586.  
  3587.            { third arg, length only if is_real }
  3588.            if hp^.is_colon_para then
  3589.              begin
  3590.                 dummycoll.data:=hp^.resulttype;
  3591.                 secondcallparan(hp,@dummycoll,false);
  3592.                 if codegenerror then
  3593.                   exit;
  3594.                 hp:=node;
  3595.                 node:=node^.right;
  3596.                 hp^.right:=nil;
  3597.              end
  3598.            else
  3599.              if is_real then
  3600.                push_int(-32767)
  3601.              else
  3602.                push_int(-1);
  3603.  
  3604.            { last arg longint or real }
  3605.            secondcallparan(hp,@dummycoll,false);
  3606.            if codegenerror then
  3607.              exit;
  3608.  
  3609.            if is_real then
  3610.              emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
  3611.            else if porddef(hp^.resulttype)^.typ=u32bit then
  3612.              emitcall('STR_CARDINAL',true)
  3613.            else
  3614.              emitcall('STR_LONGINT',true);
  3615.            popusedregisters(pushed);
  3616.         end;
  3617.  
  3618.       var
  3619.          r : preference;
  3620.  
  3621.       begin
  3622.          case p^.inlinenumber of
  3623.             in_lo_word,
  3624.             in_hi_word :
  3625.               begin
  3626.                  secondpass(p^.left);
  3627.                  p^.location.loc:=LOC_REGISTER;
  3628.                  if p^.left^.location.loc<>LOC_REGISTER then
  3629.                    begin
  3630.                      if p^.left^.location.loc=LOC_CREGISTER then
  3631.                        begin
  3632.                           p^.location.register:=reg32toreg16(getregister32);
  3633.                           emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
  3634.                             p^.location.register);
  3635.                        end
  3636.                      else
  3637.                        begin
  3638.                           del_reference(p^.left^.location.reference);
  3639.                           p^.location.register:=reg32toreg16(getregister32);
  3640.                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
  3641.                             p^.location.register)));
  3642.                        end;
  3643.                    end
  3644.                  else p^.location.register:=p^.left^.location.register;
  3645.                  if p^.inlinenumber=in_hi_word then
  3646.                    exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
  3647.                  p^.location.register:=reg16toreg8(p^.location.register);
  3648.               end;
  3649.             in_high_x :
  3650.               begin
  3651.                  if is_open_array(p^.left^.resulttype) then
  3652.                    begin
  3653.                       secondpass(p^.left);
  3654.                       del_reference(p^.left^.location.reference);
  3655.                       p^.location.register:=getregister32;
  3656.                       new(r);
  3657.                       reset_reference(r^);
  3658.                       r^.base:=highframepointer;
  3659.                       r^.offset:=highoffset+4;
  3660.                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  3661.                         r,p^.location.register)));
  3662.                    end
  3663.               end;
  3664.             in_sizeof_x,
  3665.             in_typeof_x :
  3666.               begin
  3667.                  { for both cases load vmt }
  3668.                  if p^.left^.treetype=typen then
  3669.                    begin
  3670.                       p^.location.register:=getregister32;
  3671.                       exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
  3672.                         S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
  3673.                         p^.location.register)));
  3674.                    end
  3675.                  else
  3676.                    begin
  3677.                       secondpass(p^.left);
  3678.                       del_reference(p^.left^.location.reference);
  3679.                       p^.location.loc:=LOC_REGISTER;
  3680.                       p^.location.register:=getregister32;
  3681.                       { load VMT pointer }
  3682.                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  3683.                       newreference(p^.left^.location.reference),
  3684.                         p^.location.register)));
  3685.                    end;
  3686.                  { in sizeof load size }
  3687.                  if p^.inlinenumber=in_sizeof_x then
  3688.                    begin
  3689.                       new(r);
  3690.                       reset_reference(r^);
  3691.                       r^.base:=p^.location.register;
  3692.                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
  3693.                         p^.location.register)));
  3694.                    end;
  3695.               end;
  3696.             in_lo_long,
  3697.             in_hi_long :
  3698.               begin
  3699.                  secondpass(p^.left);
  3700.                  p^.location.loc:=LOC_REGISTER;
  3701.                  if p^.left^.location.loc<>LOC_REGISTER then
  3702.                    begin
  3703.                       if p^.left^.location.loc=LOC_CREGISTER then
  3704.                         begin
  3705.                            p^.location.register:=getregister32;
  3706.                            emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  3707.                              p^.location.register);
  3708.                         end
  3709.                       else
  3710.                         begin
  3711.                            del_reference(p^.left^.location.reference);
  3712.                            p^.location.register:=getregister32;
  3713.                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  3714.                              p^.location.register)));
  3715.                         end;
  3716.                    end
  3717.                  else p^.location.register:=p^.left^.location.register;
  3718.                  if p^.inlinenumber=in_hi_long then
  3719.                    exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
  3720.                  p^.location.register:=reg32toreg16(p^.location.register);
  3721.               end;
  3722. {***CHARBUG}
  3723. {We can now comment them out, as they are handled as typecast.
  3724.  Saves an incredible amount of 8 bytes code.
  3725.  I'am not lucky about this, because it's _not_ a type cast (FK) }
  3726. {              in_ord_char,
  3727.                in_chr_byte,}
  3728. {***}
  3729.             in_length_string :
  3730.               begin
  3731.                  secondpass(p^.left);
  3732.                  set_location(p^.location,p^.left^.location);
  3733.               end;
  3734.             in_pred_x,
  3735.             in_succ_x:
  3736.               begin
  3737.                  secondpass(p^.left);
  3738.                  if p^.inlinenumber=in_pred_x then
  3739.                    asmop:=A_DEC
  3740.                  else
  3741.                    asmop:=A_INC;
  3742.                  case p^.resulttype^.size of
  3743.                    4 : opsize:=S_L;
  3744.                    2 : opsize:=S_W;
  3745.                    1 : opsize:=S_B;
  3746.                  else
  3747.                    internalerror(10080);
  3748.                  end;
  3749.                  p^.location.loc:=LOC_REGISTER;
  3750.                  if p^.left^.location.loc<>LOC_REGISTER then
  3751.                    begin
  3752.                       p^.location.register:=getregister32;
  3753.                       if (p^.resulttype^.size=2) then
  3754.                         p^.location.register:=reg32toreg16(p^.location.register);
  3755.                       if (p^.resulttype^.size=1) then
  3756.                         p^.location.register:=reg32toreg8(p^.location.register);
  3757.                       if p^.left^.location.loc=LOC_CREGISTER then
  3758.                         emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  3759.                           p^.location.register)
  3760.                       else
  3761.                       if p^.left^.location.loc=LOC_FLAGS then
  3762.                         exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
  3763.                                   p^.location.register)))
  3764.                       else
  3765.                         begin
  3766.                            del_reference(p^.left^.location.reference);
  3767.                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  3768.                              p^.location.register)));
  3769.                         end;
  3770.                    end
  3771.                  else p^.location.register:=p^.left^.location.register;
  3772.                  exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
  3773.                    p^.location.register)))
  3774.                  { here we should insert bounds check ? }
  3775.                  { and direct call to bounds will crash the program }
  3776.                  { if we are at the limit }
  3777.                  { we could also simply say that pred(first)=first and succ(last)=last }
  3778.                  { could this be usefull I don't think so (PM)
  3779.                  emitoverflowcheck;}
  3780.               end;
  3781.             in_inc_byte..in_dec_dword:
  3782.               begin
  3783.                  secondpass(p^.left);
  3784.                  if cs_check_overflow in aktswitches then
  3785.                    begin
  3786.                    { SINCE THE CARRY FLAG IS NEVER SET BY DEC/INC, we must use  }
  3787.                    { ADD and SUB to check for overflow for unsigned operations. }
  3788.                      exprasmlist^.concat(new(pai386,op_const_ref(ad2instr[p^.inlinenumber],
  3789.                        in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
  3790.                      emitoverflowcheck(p^.left);
  3791.                    end
  3792.                  else
  3793.                  exprasmlist^.concat(new(pai386,op_ref(in2instr[p^.inlinenumber],
  3794.                    in2size[p^.inlinenumber],newreference(p^.left^.location.reference))));
  3795.               end;
  3796.             in_assigned_x :
  3797.               begin
  3798.                  secondpass(p^.left^.left);
  3799.                  p^.location.loc:=LOC_FLAGS;
  3800.                  if (p^.left^.left^.location.loc=LOC_REGISTER) or
  3801.                     (p^.left^.left^.location.loc=LOC_CREGISTER) then
  3802.                    begin
  3803.                       exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
  3804.                         p^.left^.left^.location.register,
  3805.                         p^.left^.left^.location.register)));
  3806.                       ungetregister32(p^.left^.left^.location.register);
  3807.                    end
  3808.                  else
  3809.                    begin
  3810.                       exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  3811.                         newreference(p^.left^.left^.location.reference))));
  3812.                       del_reference(p^.left^.left^.location.reference);
  3813.                    end;
  3814.                  p^.location.resflags:=F_NE;
  3815.               end;
  3816.              in_reset_typedfile,in_rewrite_typedfile :
  3817.                begin
  3818.                   pushusedregisters(pushed,$ff);
  3819.                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
  3820.                   secondload(p^.left);
  3821.                   emitpushreferenceaddr(p^.left^.location.reference);
  3822.                   if p^.inlinenumber=in_reset_typedfile then
  3823.                     emitcall('RESET_TYPED',true)
  3824.                   else
  3825.                     emitcall('REWRITE_TYPED',true);
  3826.                   popusedregisters(pushed);
  3827.                end;
  3828.             in_write_x :
  3829.               handlereadwrite(false,false);
  3830.             in_writeln_x :
  3831.               handlereadwrite(false,true);
  3832.             in_read_x :
  3833.               handlereadwrite(true,false);
  3834.             in_readln_x :
  3835.               begin
  3836.                 handlereadwrite(true,false);
  3837.                 pushusedregisters(pushed,$ff);
  3838.                 emit_push_mem(aktfile);
  3839.                 { pushexceptlabel; }
  3840.                 if ft<>ft_text then
  3841.                   Message(parser_e_illegal_parameter_list);
  3842.                 emitcall('READLN_TEXT',true);
  3843.                 popusedregisters(pushed);
  3844.                 maybe_loadesi;
  3845.               end;
  3846.             in_str_x_string :
  3847.               begin
  3848.                  handle_str;
  3849.                  maybe_loadesi;
  3850.               end;
  3851.             else internalerror(9);
  3852.          end;
  3853.       end;
  3854.  
  3855.     procedure secondsubscriptn(var p : ptree);
  3856.  
  3857.       var
  3858.          hr : tregister;
  3859.  
  3860.       begin
  3861.          secondpass(p^.left);
  3862.  
  3863.          if codegenerror then
  3864.              exit;
  3865.          { classes must be dereferenced implicit }
  3866.          if (p^.left^.resulttype^.deftype=objectdef) and
  3867.            pobjectdef(p^.left^.resulttype)^.isclass then
  3868.            begin
  3869.              clear_reference(p^.location.reference);
  3870.              case p^.left^.location.loc of
  3871.                 LOC_REGISTER:
  3872.                   p^.location.reference.base:=p^.left^.location.register;
  3873.                 LOC_CREGISTER:
  3874.                   begin
  3875.                      { ... and reserve one for the pointer }
  3876.                      hr:=getregister32;
  3877.                      emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  3878.                        p^.location.reference.base:=hr;
  3879.                   end;
  3880.                 else
  3881.                   begin
  3882.                      { free register }
  3883.                      del_reference(p^.left^.location.reference);
  3884.  
  3885.                      { ... and reserve one for the pointer }
  3886.                      hr:=getregister32;
  3887.                      exprasmlist^.concat(new(pai386,op_ref_reg(
  3888.                        A_MOV,S_L,newreference(p^.left^.location.reference),
  3889.                        hr)));
  3890.                      p^.location.reference.base:=hr;
  3891.                   end;
  3892.              end;
  3893.            end
  3894.          else
  3895.            set_location(p^.location,p^.left^.location);
  3896.  
  3897.          inc(p^.location.reference.offset,p^.vs^.address);
  3898.       end;
  3899.  
  3900.     procedure secondselfn(var p : ptree);
  3901.  
  3902.       begin
  3903.          clear_reference(p^.location.reference);
  3904.          if (p^.resulttype^.deftype=classrefdef) or
  3905.            ((p^.resulttype^.deftype=objectdef)
  3906.              and pobjectdef(p^.resulttype)^.isclass
  3907.            ) then
  3908.            p^.location.register:=R_ESI
  3909.          else
  3910.            p^.location.reference.base:=R_ESI;
  3911.       end;
  3912.  
  3913.     procedure secondhdisposen(var p : ptree);
  3914.  
  3915.       begin
  3916.          secondpass(p^.left);
  3917.  
  3918.          if codegenerror then
  3919.            exit;
  3920.          clear_reference(p^.location.reference);
  3921.          case p^.left^.location.loc of
  3922.             LOC_REGISTER,
  3923.             LOC_CREGISTER:
  3924.               begin
  3925.                  p^.location.reference.index:=getregister32;
  3926.                  exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
  3927.                    p^.left^.location.register,
  3928.                    p^.location.reference.index)));
  3929.               end;
  3930.             LOC_MEM,LOC_REFERENCE :
  3931.                             begin
  3932.                                del_reference(p^.left^.location.reference);
  3933.                                p^.location.reference.index:=getregister32;
  3934.                                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  3935.                                  p^.location.reference.index)));
  3936.                             end;
  3937.          end;
  3938.       end;
  3939.  
  3940.     procedure secondhnewn(var p : ptree);
  3941.  
  3942.       begin
  3943.        end;
  3944.  
  3945.     procedure secondnewn(var p : ptree);
  3946.  
  3947.       begin
  3948.          secondpass(p^.left);
  3949.  
  3950.            if codegenerror then
  3951.            exit;
  3952.  
  3953.          p^.location.register:=p^.left^.location.register;
  3954.       end;
  3955.  
  3956.     procedure secondsimplenewdispose(var p : ptree);
  3957.  
  3958.       var
  3959.          pushed : tpushed;
  3960.       begin
  3961.          secondpass(p^.left);
  3962.          if codegenerror then
  3963.            exit;
  3964.  
  3965.          pushusedregisters(pushed,$ff);
  3966.          { determines the size of the mem block }
  3967.          push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
  3968.  
  3969.          { push pointer adress }
  3970.          case p^.left^.location.loc of
  3971.             LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  3972.               p^.left^.location.register)));
  3973.             LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
  3974.  
  3975.          end;
  3976.  
  3977.          { call the mem handling procedures }
  3978.          case p^.treetype of
  3979.            simpledisposen:
  3980.              emitcall('FREEMEM',true);
  3981.            simplenewn:
  3982.              emitcall('GETMEM',true);
  3983.          end;
  3984.  
  3985.          popusedregisters(pushed);
  3986.            { may be load ESI }
  3987.            maybe_loadesi;
  3988.        end;
  3989.  
  3990.      { copies p a set element on the stack }
  3991.  
  3992.      procedure pushsetelement(var p : ptree);
  3993.  
  3994.       var
  3995.          hr : tregister;
  3996.  
  3997.       begin
  3998.            { copy the element on the stack, slightly complicated }
  3999.          case p^.location.loc of
  4000.                LOC_REGISTER,
  4001.             LOC_CREGISTER : begin
  4002.                               hr:=p^.location.register;
  4003.                               case hr of
  4004.                                  R_EAX,R_EBX,R_ECX,R_EDX,R_EDI,R_ESI,R_ESP :
  4005.                                    begin
  4006.                                       ungetregister32(hr);
  4007.                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,reg32toreg16(hr))));
  4008.                                    end;
  4009.                                  R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  4010.                                    begin
  4011.                                       ungetregister32(reg16toreg32(hr));
  4012.                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,hr)));
  4013.                                    end;
  4014.                                  R_AL,R_BL,R_CL,R_DL :
  4015.                                    begin
  4016.                                       ungetregister32(reg8toreg32(hr));
  4017.                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,reg8toreg16(hr))));
  4018.                                    end;
  4019.                               end;
  4020.                            end;
  4021.             else
  4022.                begin
  4023.                   exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,newreference(p^.location.reference))));
  4024.                   del_reference(p^.location.reference);
  4025.                end;
  4026.          end;
  4027.       end;
  4028.  
  4029.     procedure secondsetcons(var p : ptree);
  4030.  
  4031.       var
  4032.          l : plabel;
  4033.          i,smallsetvalue : longint;
  4034.          hp : ptree;
  4035.          href,sref : treference;
  4036.  
  4037.       begin
  4038.          { this should be reimplemented for smallsets }
  4039.          { differently  (PM) }
  4040.          { produce constant part }
  4041.          href.symbol := Nil;
  4042.          clear_reference(href);
  4043.          getlabel(l);
  4044.          href.symbol:=stringdup(lab2str(l));
  4045.          stringdispose(p^.location.reference.symbol);
  4046.          datasegment^.concat(new(pai_label,init(l)));
  4047.            {if psetdef(p^.resulttype)=smallset then
  4048.            begin
  4049.               smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
  4050.               smallsetvalue:=((smallset*256+p^.constset^[1])*256+p^.constset^[1];
  4051.               datasegment^.concat(new(pai_const,init_32bit(smallsetvalue)));
  4052.               hp:=p^.left;
  4053.               if assigned(hp) then
  4054.                 begin
  4055.                    sref.symbol:=nil;
  4056.                    gettempofsizereference(32,sref);
  4057.                      concatcopy(href,sref,32,false);
  4058.                    while assigned(hp) do
  4059.                      begin
  4060.                         secondpass(hp^.left);
  4061.                         if codegenerror then
  4062.                           exit;
  4063.  
  4064.                         pushsetelement(hp^.left);
  4065.                         emitpushreferenceaddr(sref);
  4066.                          register is save in subroutine
  4067.                         emitcall('SET_SET_BYTE',true);
  4068.                         hp:=hp^.right;
  4069.                      end;
  4070.                    p^.location.reference:=sref;
  4071.                 end
  4072.               else p^.location.reference:=href;
  4073.            end
  4074.          else    }
  4075.            begin
  4076.            for i:=0 to 31 do
  4077.              datasegment^.concat(new(pai_const,init_8bit(p^.constset^[i])));
  4078.          hp:=p^.left;
  4079.          if assigned(hp) then
  4080.            begin
  4081.               sref.symbol:=nil;
  4082.               gettempofsizereference(32,sref);
  4083.                 concatcopy(href,sref,32,false);
  4084.               while assigned(hp) do
  4085.                 begin
  4086.                    secondpass(hp^.left);
  4087.                    if codegenerror then
  4088.                      exit;
  4089.  
  4090.                    pushsetelement(hp^.left);
  4091.                    emitpushreferenceaddr(sref);
  4092.                    { register is save in subroutine }
  4093.                    emitcall('SET_SET_BYTE',true);
  4094.                    hp:=hp^.right;
  4095.                 end;
  4096.               p^.location.reference:=sref;
  4097.            end
  4098.          else p^.location.reference:=href;
  4099.          end;
  4100.       end;
  4101.  
  4102.     { could be built into secondadd but it }
  4103.     { should be easy to read }
  4104.     procedure secondin(var p : ptree);
  4105.  
  4106.  
  4107.        type    Tsetpart=record
  4108.                     range:boolean;      {Part is a range.}
  4109.                     start,stop:byte;    {Start/stop when range; Stop=element
  4110.                                               when an element.}
  4111.                end;
  4112.  
  4113.        var
  4114.            pushed,ranges : boolean;
  4115.            hr : tregister;
  4116.            setparts:array[1..8] of Tsetpart;
  4117.            i,numparts:byte;
  4118.            href,href2:Treference;
  4119.            l,l2 : plabel;
  4120.  
  4121.                function swaplongint(l : longint): longint;
  4122.                var
  4123.                  w1: word;
  4124.                  w2: word;
  4125.                begin
  4126.                  w1:=l and $ffff;
  4127.                  w2:=l shr 16;
  4128.                  l:=swap(w2)+(longint(swap(w1)) shl 16);
  4129.                  swaplongint:=l;
  4130.                end;
  4131.  
  4132.  
  4133.  
  4134.                function analizeset(Aset:Pconstset):boolean;
  4135.  
  4136.                type byteset=set of byte;
  4137.                     tlongset  = array[0..7] of longint;
  4138.                var  compares,maxcompares:word;
  4139.                     i:byte;
  4140.                     someset : tlongset;
  4141.  
  4142.  
  4143.                begin
  4144.                     analizeset:=false;
  4145.                     ranges:=false;
  4146.                     numparts:=0;
  4147.                     compares:=0;
  4148.                     {Lots of comparisions take a lot of time, so do not allow
  4149.                      too much comparisions. 8 comparisions are, however, still
  4150.                      smalller than emitting the set.}
  4151.                     maxcompares:=5;
  4152.                     if cs_littlesize in aktswitches then
  4153.                          maxcompares:=8;
  4154.                 move(ASet^,someset,32);
  4155.                 { On Big endian machines sets are stored   }
  4156.                 { as INTEL Little-endian format, therefore }
  4157.                 { we must convert it to the correct format }
  4158. {$IFDEF BIG_ENDIAN}
  4159.                 for I:=0 to 7 do
  4160.                   someset[i]:=swaplongint(someset[i]);
  4161. {$ENDIF}
  4162.                     for i:=0 to 255 do
  4163.                          if i in byteset(someset) then
  4164.                               begin
  4165.                                    if (numparts=0) or
  4166.                                     (i<>setparts[numparts].stop+1) then
  4167.                                         begin
  4168.                                              {Set element is a separate element.}
  4169.                                              inc(compares);
  4170.                                              if compares>maxcompares then
  4171.                                                   exit;
  4172.                                              inc(numparts);
  4173.                                              setparts[numparts].range:=false;
  4174.                                              setparts[numparts].stop:=i;
  4175.                                         end
  4176.                                     else
  4177.                                         {Set element is part of a range.}
  4178.                                         if not setparts[numparts].range then
  4179.                                              begin
  4180.                                                   {Transform an element into a range.}
  4181.                                                   setparts[numparts].range:=true;
  4182.                                                   setparts[numparts].start:=
  4183.                                                    setparts[numparts].stop;
  4184.                                                   setparts[numparts].stop:=i;
  4185.                                                   inc(compares);
  4186.                                                   if compares>maxcompares then
  4187.                                                        exit;
  4188.                                              end
  4189.                                         else
  4190.                                              begin
  4191.                                                   {Extend a range.}
  4192.                                                   setparts[numparts].stop:=i;
  4193.                                                   {A range of two elements can better
  4194.                                                    be checked as two separate ones.
  4195.                                                    When extending a range, our range
  4196.                                                    becomes larger than two elements.}
  4197.                                                   ranges:=true;
  4198.                                              end;
  4199.                               end;
  4200.                     analizeset:=true;
  4201.                end;
  4202.  
  4203.        begin
  4204.            if psetdef(p^.right^.resulttype)^.settype=smallset then
  4205.              begin
  4206.                  if p^.left^.treetype=ordconstn then
  4207.                     begin
  4208.                        { only compulsory }
  4209.                        secondpass(p^.left);
  4210.                             secondpass(p^.right);
  4211.                        if codegenerror then
  4212.                           exit;
  4213.                        p^.location.resflags:=F_NE;
  4214.                        case p^.right^.location.loc of
  4215.                           LOC_REGISTER,LOC_CREGISTER:
  4216.                             begin
  4217.                                exprasmlist^.concat(new(pai386,op_const_reg(
  4218.                                  A_TEST,S_L,1 shl (p^.left^.value and 31),
  4219.                                  p^.right^.location.register)));
  4220.                                ungetregister32(p^.right^.location.register);
  4221.                             end
  4222.                           else
  4223.                             begin
  4224.                                exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_L,1 shl (p^.left^.value and 31),
  4225.                                  newreference(p^.right^.location.reference))));
  4226.                                del_reference(p^.right^.location.reference);
  4227.                             end;
  4228.                        end;
  4229.                     end
  4230.                  else
  4231.                     begin
  4232.                        { calculate both operators }
  4233.                        { the complex one first }
  4234.                        firstcomplex(p);
  4235.                        secondpass(p^.left);
  4236.                        { are too few registers free? }
  4237.                        pushed:=maybe_push(p^.right^.registers32,p^.left);
  4238.                        secondpass(p^.right);
  4239.                        if pushed then
  4240.                           restore(p^.left);
  4241.                        { of course not commutative }
  4242.                        if p^.swaped then
  4243.                               swaptree(p);
  4244.                        case p^.left^.location.loc of
  4245.                          LOC_REGISTER,
  4246.                          LOC_CREGISTER:
  4247.                            begin
  4248.                               hr:=p^.left^.location.register;
  4249.                               case p^.left^.location.register of
  4250.                                  R_AX,R_BX,R_CX,R_DX,R_DI,R_SI,R_SP :
  4251.                                     begin
  4252.                                         hr:=reg16toreg32(p^.left^.location.register);
  4253.                                         ungetregister32(hr);
  4254.                                         exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,
  4255.                                           p^.left^.location.register,hr)));
  4256.                                     end;
  4257.                                  R_AL,R_BL,R_CL,R_DL :
  4258.                                     begin
  4259.                                         hr:=reg8toreg32(p^.left^.location.register);
  4260.                                         ungetregister32(hr);
  4261.                                         exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,
  4262.                                           p^.left^.location.register,hr)));
  4263.                                     end;
  4264.                               end;
  4265.                            end;
  4266.                          else
  4267.                              begin
  4268.                                  { the set element isn't never samller than a byte  }
  4269.                                  { and because it's a small set we need only 5 bits }
  4270.                                  { but 8 bits are eaiser to load                    }
  4271.                                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
  4272.                                    newreference(p^.left^.location.reference),R_EDI)));
  4273.                                  hr:=R_EDI;
  4274.                                  del_reference(p^.left^.location.reference);
  4275.                              end;
  4276.                        end;
  4277.                        case p^.right^.location.loc of
  4278.                          LOC_REGISTER,
  4279.                          LOC_CREGISTER:
  4280.                            exprasmlist^.concat(new(pai386,op_reg_reg(A_BT,S_L,hr,
  4281.                              p^.right^.location.register)));
  4282.                          else
  4283.                             begin
  4284.                                exprasmlist^.concat(new(pai386,op_reg_ref(A_BT,S_L,hr,
  4285.                                  newreference(p^.right^.location.reference))));
  4286.                                         del_reference(p^.right^.location.reference);
  4287.                             end;
  4288.                        end;
  4289.                        p^.location.loc:=LOC_FLAGS;
  4290.                        p^.location.resflags:=F_C;
  4291.                     end;
  4292.              end
  4293.            else
  4294.              begin
  4295.                  if p^.left^.treetype=ordconstn then
  4296.                     begin
  4297.                        { only compulsory }
  4298.                        secondpass(p^.left);
  4299.                        secondpass(p^.right);
  4300.                        if codegenerror then
  4301.                           exit;
  4302.                        p^.location.resflags:=F_NE;
  4303.                        inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
  4304.                        exprasmlist^.concat(new(pai386,op_const_ref(A_TEST,S_B,1 shl (p^.left^.value and 7),
  4305.                           newreference(p^.right^.location.reference))));
  4306.                        del_reference(p^.right^.location.reference);
  4307.                     end
  4308.                  else
  4309.                     begin
  4310.                        if (p^.right^.treetype=setconstrn) and
  4311.                          analizeset(p^.right^.constset) then
  4312.                          begin
  4313.                             {It gives us advantage to check for the set elements
  4314.                              separately instead of using the SET_IN_BYTE procedure.
  4315.                              To do: Build in support for LOC_JUMP.}
  4316.                             secondpass(p^.left);
  4317.                             {We won't do a second pass on p^.right, because
  4318.                              this will emit the constant set.}
  4319.                             {If register is used, use only lower 8 bits}
  4320.  
  4321.                             case p^.left^.location.loc of
  4322.                                LOC_REGISTER,
  4323.                                LOC_CREGISTER :
  4324.                                  exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_B,
  4325.                                    255,p^.left^.location.register)));
  4326.                             end;
  4327.                             {Get a label to jump to the end.}
  4328.                             p^.location.loc:=LOC_FLAGS;
  4329.                             {It's better to use the zero flag when there are
  4330.                              no ranges.}
  4331.                             if ranges then
  4332.                               p^.location.resflags:=F_C
  4333.                             else
  4334.                               p^.location.resflags:=F_E;
  4335.                             href.symbol := nil;
  4336.                             clear_reference(href);
  4337.                             getlabel(l);
  4338.                             href.symbol:=stringdup(lab2str(l));
  4339.                             for i:=1 to numparts do
  4340.                               if setparts[i].range then
  4341.                                 begin
  4342.                                    {Check if left is in a range.}
  4343.                                    {Get a label to jump over the check.}
  4344.                                    href2.symbol := nil;
  4345.                                    clear_reference(href2);
  4346.                                    getlabel(l2);
  4347.                                    href.symbol:=stringdup(lab2str(l2));
  4348.                                    if setparts[i].start=setparts[i].stop-1 then
  4349.                                      begin
  4350.                                         case p^.left^.location.loc of
  4351.                                            LOC_REGISTER,
  4352.                                            LOC_CREGISTER :
  4353.                                              exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_B,
  4354.                                                setparts[i].start,p^.left^.location.register)));
  4355.                                            else
  4356.                                              exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  4357.                                                setparts[i].start,newreference(p^.left^.location.reference))));
  4358.                                         end;
  4359.                                         {Result should be in carry flag when ranges are used.}
  4360.                                         if ranges then
  4361.                                           exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  4362.                                         {If found, jump to end.}
  4363.                                         emitl(A_JE,l);
  4364.                                         case p^.left^.location.loc of
  4365.                                            LOC_REGISTER,
  4366.                                            LOC_CREGISTER:
  4367.                                              exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_B,
  4368.                                                setparts[i].stop,p^.left^.location.register)));
  4369.                                            else
  4370.                                              exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  4371.                                                setparts[i].stop,newreference(p^.left^.location.reference))));
  4372.                                         end;
  4373.                                         {Result should be in carry flag when ranges are used.}
  4374.                                         if ranges then
  4375.                                           exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  4376.                                         {If found, jump to end.}
  4377.                                         emitl(A_JE,l);
  4378.                                      end
  4379.                                    else
  4380.                                      begin
  4381.                                         if setparts[i].start<>0 then
  4382.                                           begin
  4383.                                              { We only check for the lower bound if it is > 0, because
  4384.                                              set elements lower than 0 do nt exist.}
  4385.                                              case p^.left^.location.loc of
  4386.                                                LOC_REGISTER,
  4387.                                                LOC_CREGISTER :
  4388.                                                  exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_B,
  4389.                                                  setparts[i].start,p^.left^.location.register)));
  4390.                                                else
  4391.                                                  exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  4392.                                                setparts[i].start,newreference(p^.left^.location.reference))));
  4393.                                              end;
  4394.                                              {If lower, jump to next check.}
  4395.                                              emitl(A_JB,l2);
  4396.                                           end;
  4397.                                         if setparts[i].stop<>255 then
  4398.                                           begin
  4399.                                              { We only check for the high bound if it is < 255, because
  4400.                                                set elements higher than 255 do nt exist.}
  4401.                                              case p^.left^.location.loc of
  4402.                                                LOC_REGISTER,
  4403.                                                LOC_CREGISTER :
  4404.                                                  exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_B,
  4405.                                                    setparts[i].stop+1,p^.left^.location.register)));
  4406.                                                else
  4407.                                                  exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  4408.                                                    setparts[i].stop+1,newreference(p^.left^.location.reference))));
  4409.                                              end;
  4410.                                              {If higher, element is in set.}
  4411.                                              emitl(A_JB,l);
  4412.                                           end
  4413.                                         else
  4414.                                           begin
  4415.                                             exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  4416.                                             emitl(A_JMP,l);
  4417.                                           end;
  4418.  
  4419.                                       end;
  4420.                                    {Emit the jump over label.}
  4421.                                    exprasmlist^.concat(new(pai_label,init(l2)));
  4422.                                 end
  4423.                               else
  4424.                                 begin
  4425.                                    {Emit code to check if left is an element.}
  4426.                                    case p^.left^.location.loc of
  4427.                                       LOC_REGISTER,
  4428.                                       LOC_CREGISTER:
  4429.                                         exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,S_B,
  4430.                                           setparts[i].stop,p^.left^.location.register)));
  4431.                                       else
  4432.                                         exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_B,
  4433.                                           setparts[i].stop,newreference(p^.left^.location.reference))));
  4434.                                    end;
  4435.                                    {Result should be in carry flag when ranges are used.}
  4436.                                    if ranges then
  4437.                                      exprasmlist^.concat(new(pai386,op_none(A_STC,S_NO)));
  4438.                                    {If found, jump to end.}
  4439.                                    emitl(A_JE,l);
  4440.                                 end;
  4441.                             if ranges then
  4442.                               exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
  4443.                             {To compensate for not doing a second pass.}
  4444.                             stringdispose(p^.right^.location.reference.symbol);
  4445.                             {Now place the end label.}
  4446.                             exprasmlist^.concat(new(pai_label,init(l)));
  4447.                             case p^.left^.location.loc of
  4448.                                LOC_REGISTER,
  4449.                                LOC_CREGISTER:
  4450.                                  ungetregister32(p^.left^.location.register);
  4451.                                else
  4452.                                  del_reference(p^.left^.location.reference);
  4453.                             end;
  4454.                          end
  4455.                        else
  4456.                          begin
  4457.                             { calculate both operators }
  4458.                             { the complex one first }
  4459.                             firstcomplex(p);
  4460.                             secondpass(p^.left);
  4461.                             { are too few registers free? }
  4462.                             pushed:=maybe_push(p^.right^.registers32,p);
  4463.                             secondpass(p^.right);
  4464.                             if pushed then restore(p);
  4465.                             { of course not commutative }
  4466.                             if p^.swaped then
  4467.                               swaptree(p);
  4468.                             pushsetelement(p^.left);
  4469.                             emitpushreferenceaddr(p^.right^.location.reference);
  4470.                             del_reference(p^.right^.location.reference);
  4471.                             { registers need not be save. that happens in SET_IN_BYTE }
  4472.                             { (EDI is changed) }
  4473.                             emitcall('SET_IN_BYTE',true);
  4474.                             { ungetiftemp(p^.right^.location.reference); }
  4475.                             p^.location.loc:=LOC_FLAGS;
  4476.                             p^.location.resflags:=F_C;
  4477.                          end;
  4478.                     end;
  4479.                 end;
  4480.        end;
  4481. {***}
  4482.  
  4483.     procedure secondexpr(var p : ptree);
  4484.  
  4485.       begin
  4486.          secondpass(p^.left);
  4487.       end;
  4488.  
  4489.     procedure secondblockn(var p : ptree);
  4490.  
  4491.       var
  4492.          hp : ptree;
  4493.  
  4494.       begin
  4495.          hp:=p^.left;
  4496.          while assigned(hp) do
  4497.            begin
  4498.               { assignments could be distance optimized }
  4499.               if assigned(hp^.right) then
  4500.                 begin
  4501.                    cleartempgen;
  4502.                    secondpass(hp^.right);
  4503.                 end;
  4504.               hp:=hp^.left;
  4505.            end;
  4506.       end;
  4507.  
  4508.     procedure second_while_repeatn(var p : ptree);
  4509.  
  4510.       var
  4511.          l1,l2,l3,oldclabel,oldblabel : plabel;
  4512.          otlabel,oflabel : plabel;
  4513.  
  4514.       begin
  4515.          getlabel(l1);
  4516.          getlabel(l2);
  4517.          { arrange continue and breaklabels: }
  4518.          oldclabel:=aktcontinuelabel;
  4519.          oldblabel:=aktbreaklabel;
  4520.          if p^.treetype=repeatn then
  4521.            begin
  4522.               emitl(A_LABEL,l1);
  4523.               aktcontinuelabel:=l1;
  4524.               aktbreaklabel:=l2;
  4525.               cleartempgen;
  4526.               if assigned(p^.right) then
  4527.                   secondpass(p^.right);
  4528.  
  4529.               otlabel:=truelabel;
  4530.               oflabel:=falselabel;
  4531.               truelabel:=l2;
  4532.               falselabel:=l1;
  4533.               cleartempgen;
  4534.               secondpass(p^.left);
  4535.               maketojumpbool(p^.left);
  4536.               emitl(A_LABEL,l2);
  4537.               truelabel:=otlabel;
  4538.               falselabel:=oflabel;
  4539.            end
  4540.          else
  4541.            begin
  4542.               { handling code at the end as it is much more efficient }
  4543.               emitl(A_JMP,l2);
  4544.  
  4545.               emitl(A_LABEL,l1);
  4546.               cleartempgen;
  4547.  
  4548.               getlabel(l3);
  4549.               aktcontinuelabel:=l2;
  4550.               aktbreaklabel:=l3;
  4551.  
  4552.               if assigned(p^.right) then
  4553.                 secondpass(p^.right);
  4554.  
  4555.               emitl(A_LABEL,l2);
  4556.               otlabel:=truelabel;
  4557.               oflabel:=falselabel;
  4558.               truelabel:=l1;
  4559.               falselabel:=l3;
  4560.               cleartempgen;
  4561.               secondpass(p^.left);
  4562.               maketojumpbool(p^.left);
  4563.  
  4564.               emitl(A_LABEL,l3);
  4565.               truelabel:=otlabel;
  4566.               falselabel:=oflabel;
  4567.            end;
  4568.          aktcontinuelabel:=oldclabel;
  4569.          aktbreaklabel:=oldblabel;
  4570.       end;
  4571.  
  4572.     procedure secondifn(var p : ptree);
  4573.  
  4574.       var
  4575.          hl,otlabel,oflabel : plabel;
  4576.  
  4577.       begin
  4578.          otlabel:=truelabel;
  4579.          oflabel:=falselabel;
  4580.          getlabel(truelabel);
  4581.          getlabel(falselabel);
  4582.          cleartempgen;
  4583.          secondpass(p^.left);
  4584.          maketojumpbool(p^.left);
  4585.          if assigned(p^.right) then
  4586.            begin
  4587.               emitl(A_LABEL,truelabel);
  4588.               cleartempgen;
  4589.               secondpass(p^.right);
  4590.            end;
  4591.          if assigned(p^.t1) then
  4592.                begin
  4593.               if assigned(p^.right) then
  4594.                         begin
  4595.                    getlabel(hl);
  4596.                    emitl(A_JMP,hl);
  4597.                 end;
  4598.               emitl(A_LABEL,falselabel);
  4599.               cleartempgen;
  4600.               secondpass(p^.t1);
  4601.               if assigned(p^.right) then
  4602.                 emitl(A_LABEL,hl);
  4603.            end
  4604.          else
  4605.            emitl(A_LABEL,falselabel);
  4606.          if not(assigned(p^.right)) then
  4607.            emitl(A_LABEL,truelabel);
  4608.          truelabel:=otlabel;
  4609.          falselabel:=oflabel;
  4610.       end;
  4611.  
  4612.     procedure secondbreakn(var p : ptree);
  4613.  
  4614.       begin
  4615.          if aktbreaklabel<>nil then
  4616.            emitl(A_JMP,aktbreaklabel)
  4617.          else
  4618.            Message(cg_e_break_not_allowed);
  4619.       end;
  4620.  
  4621.     procedure secondcontinuen(var p : ptree);
  4622.  
  4623.       begin
  4624.          if aktcontinuelabel<>nil then
  4625.            emitl(A_JMP,aktcontinuelabel)
  4626.          else
  4627.            Message(cg_e_continue_not_allowed);
  4628.       end;
  4629.  
  4630.     procedure secondfor(var p : ptree);
  4631.  
  4632.       var
  4633.          l3,oldclabel,oldblabel : plabel;
  4634.          omitfirstcomp,temptovalue : boolean;
  4635.          hs : byte;
  4636.          temp1 : treference;
  4637.          hop : tasmop;
  4638.          cmpreg,cmp32 : tregister;
  4639.          opsize : topsize;
  4640.          count_var_is_signed : boolean;
  4641.  
  4642.       begin
  4643.          oldclabel:=aktcontinuelabel;
  4644.          oldblabel:=aktbreaklabel;
  4645.          getlabel(aktcontinuelabel);
  4646.          getlabel(aktbreaklabel);
  4647.          getlabel(l3);
  4648.  
  4649.          { could we spare the first comparison ? }
  4650.              omitfirstcomp:=false;
  4651.          if p^.right^.treetype=ordconstn then
  4652.            if p^.left^.right^.treetype=ordconstn then
  4653.              omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
  4654.                or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
  4655.  
  4656.          { only calculate reference }
  4657.          cleartempgen;
  4658.          secondpass(p^.t2);
  4659.          if not(simple_loadn) then
  4660.           Message(cg_e_illegal_count_var);
  4661.  
  4662.          { produce start assignment }
  4663.          cleartempgen;
  4664.          secondpass(p^.left);
  4665.          count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
  4666.              hs:=p^.t2^.resulttype^.size;
  4667.          cmp32:=getregister32;
  4668.              case hs of
  4669.             1 : begin
  4670.                    opsize:=S_B;
  4671.                    cmpreg:=reg32toreg8(cmp32);
  4672.                 end;
  4673.             2 : begin
  4674.                    opsize:=S_W;
  4675.                    cmpreg:=reg32toreg16(cmp32);
  4676.                 end;
  4677.             4 : begin
  4678.                    opsize:=S_L;
  4679.                    cmpreg:=cmp32;
  4680.                 end;
  4681.          end;
  4682.          cleartempgen;
  4683.              secondpass(p^.right);
  4684.          { calculate pointer value and check if changeable and if so }
  4685.          { load into temporary variable                              }
  4686.          if p^.right^.treetype<>ordconstn then
  4687.            begin
  4688.               temp1.symbol:=nil;
  4689.               gettempofsizereference(hs,temp1);
  4690.               temptovalue:=true;
  4691.               if (p^.right^.location.loc=LOC_REGISTER) or
  4692.                  (p^.right^.location.loc=LOC_CREGISTER) then
  4693.                 begin
  4694.                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
  4695.                       newreference(temp1))));
  4696.                  end
  4697.               else
  4698.                  concatcopy(p^.right^.location.reference,temp1,hs,false);
  4699.            end
  4700.          else temptovalue:=false;
  4701.  
  4702.          if temptovalue then
  4703.              begin
  4704.               if p^.t2^.location.loc=LOC_CREGISTER then
  4705.                 begin
  4706.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  4707.                      p^.t2^.location.register)));
  4708.                 end
  4709.               else
  4710.                 begin
  4711.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  4712.                      cmpreg)));
  4713.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  4714.                      cmpreg)));
  4715.                 end;
  4716.            end
  4717.          else
  4718.              begin
  4719.               if not(omitfirstcomp) then
  4720.                 begin
  4721.                    if p^.t2^.location.loc=LOC_CREGISTER then
  4722.                      exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
  4723.                        p^.t2^.location.register)))
  4724.                    else
  4725.                      exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
  4726.                  newreference(p^.t2^.location.reference))));
  4727.                 end;
  4728.            end;
  4729.          if p^.backward then
  4730.            if count_var_is_signed then
  4731.              hop:=A_JL
  4732.            else hop:=A_JB
  4733.          else
  4734.            if count_var_is_signed then
  4735.              hop:=A_JG
  4736.             else hop:=A_JA;
  4737.  
  4738.              if not(omitfirstcomp) or temptovalue then
  4739.            emitl(hop,aktbreaklabel);
  4740.  
  4741.          emitl(A_LABEL,l3);
  4742.  
  4743.          { help register must not be in instruction block }
  4744.          cleartempgen;
  4745.          if assigned(p^.t1) then
  4746.            secondpass(p^.t1);
  4747.  
  4748.          emitl(A_LABEL,aktcontinuelabel);
  4749.  
  4750.          { makes no problems there }
  4751.          cleartempgen;
  4752.  
  4753.          { demand help register again }
  4754.          cmp32:=getregister32;
  4755.          case hs of
  4756.             1 : begin
  4757.                    opsize:=S_B;
  4758.                    cmpreg:=reg32toreg8(cmp32);
  4759.                 end;
  4760.             2 : begin
  4761.                    opsize:=S_W;
  4762.                    cmpreg:=reg32toreg16(cmp32);
  4763.                 end;
  4764.             4 : opsize:=S_L;
  4765.          end;
  4766.  
  4767.           { produce comparison and the corresponding }
  4768.          { jump                                     }
  4769.          if temptovalue then
  4770.            begin
  4771.               if p^.t2^.location.loc=LOC_CREGISTER then
  4772.                 begin
  4773.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  4774.                      p^.t2^.location.register)));
  4775.                 end
  4776.               else
  4777.                 begin
  4778.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  4779.                      cmpreg)));
  4780.                    exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  4781.                      cmpreg)));
  4782.                     end;
  4783.            end
  4784.          else
  4785.            begin
  4786.               if p^.t2^.location.loc=LOC_CREGISTER then
  4787.                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
  4788.                   p^.t2^.location.register)))
  4789.               else
  4790.                  exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
  4791.                    newreference(p^.t2^.location.reference))));
  4792.            end;
  4793.          if p^.backward then
  4794.            if count_var_is_signed then
  4795.              hop:=A_JLE
  4796.            else
  4797.              hop :=A_JBE
  4798.           else
  4799.             if count_var_is_signed then
  4800.               hop:=A_JGE
  4801.             else
  4802.                 hop:=A_JAE;
  4803.          emitl(hop,aktbreaklabel);
  4804.          { according to count direction DEC or INC... }
  4805.          { must be after the test because of 0to 255 for bytes !! }
  4806.          if p^.backward then
  4807.            hop:=A_DEC
  4808.          else hop:=A_INC;
  4809.  
  4810.          if p^.t2^.location.loc=LOC_CREGISTER then
  4811.            exprasmlist^.concat(new(pai386,op_reg(hop,opsize,p^.t2^.location.register)))
  4812.          else
  4813.              exprasmlist^.concat(new(pai386,op_ref(hop,opsize,newreference(p^.t2^.location.reference))));
  4814.          emitl(A_JMP,l3);
  4815.  
  4816.            { this is the break label: }
  4817.          emitl(A_LABEL,aktbreaklabel);
  4818.          ungetregister32(cmp32);
  4819.  
  4820.          if temptovalue then
  4821.            ungetiftemp(temp1);
  4822.  
  4823.          aktcontinuelabel:=oldclabel;
  4824.          aktbreaklabel:=oldblabel;
  4825.       end;
  4826.  
  4827. {    var
  4828.        hs : string; }
  4829.  
  4830.     procedure secondexitn(var p : ptree);
  4831.  
  4832.       var
  4833.          is_mem : boolean;
  4834.          {op : tasmop;
  4835.          s : topsize;}
  4836.          otlabel,oflabel : plabel;
  4837.  
  4838.       label
  4839.          do_jmp;
  4840.  
  4841.       begin
  4842.          if assigned(p^.left) then
  4843.            begin
  4844.               otlabel:=truelabel;
  4845.               oflabel:=falselabel;
  4846.               getlabel(truelabel);
  4847.               getlabel(falselabel);
  4848.               secondpass(p^.left);
  4849.               case p^.left^.location.loc of
  4850.                  LOC_FPU : goto do_jmp;
  4851.                  LOC_MEM,LOC_REFERENCE : is_mem:=true;
  4852.                  LOC_CREGISTER,
  4853.                  LOC_REGISTER : is_mem:=false;
  4854.                      LOC_FLAGS : begin
  4855.                                 exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,R_AL)));
  4856.                                         goto do_jmp;
  4857.                              end;
  4858.                  LOC_JUMP : begin
  4859.                                       emitl(A_LABEL,truelabel);
  4860.                                exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,R_AL)));
  4861.                                emitl(A_JMP,aktexit2label);
  4862.                                exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,R_AL,R_AL)));
  4863.                                goto do_jmp;
  4864.                             end;
  4865.                  else internalerror(2001);
  4866.               end;
  4867.                  if (procinfo.retdef^.deftype=orddef) then
  4868.                 begin
  4869.                    case porddef(procinfo.retdef)^.typ of
  4870.                       s32bit,u32bit : if is_mem then
  4871.                                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  4872.                                           newreference(p^.left^.location.reference),R_EAX)))
  4873.                                       else
  4874.                                         emit_reg_reg(A_MOV,S_L,
  4875.                                           p^.left^.location.register,R_EAX);
  4876.                            u8bit,s8bit,uchar,bool8bit : if is_mem then
  4877.                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
  4878.                                           newreference(p^.left^.location.reference),R_AL)))
  4879.                                       else
  4880.                                         emit_reg_reg(A_MOV,S_B,
  4881.                                           p^.left^.location.register,R_AL);
  4882.                       s16bit,u16bit : if is_mem then
  4883.                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  4884.                                           newreference(p^.left^.location.reference),R_AX)))
  4885.                                       else
  4886.                                         emit_reg_reg(A_MOV,S_W,
  4887.                                                     p^.left^.location.register,R_AX);
  4888.                    end;
  4889.                 end
  4890.                   else
  4891.                      if (procinfo.retdef^.deftype in
  4892.                           [pointerdef,enumdef,procvardef]) then
  4893.                        begin
  4894.                            if is_mem then
  4895.                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  4896.                                 newreference(p^.left^.location.reference),R_EAX)))
  4897.                            else
  4898.                               exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
  4899.                                 p^.left^.location.register,R_EAX)));
  4900.                        end
  4901.                  else
  4902.                     if (procinfo.retdef^.deftype=floatdef) then
  4903.                       begin
  4904.                           if pfloatdef(procinfo.retdef)^.typ=f32bit then
  4905.                             begin
  4906.                                 if is_mem then
  4907.                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  4908.                               newreference(p^.left^.location.reference),R_EAX)))
  4909.                           else
  4910.                             emit_reg_reg(A_MOV,S_L,
  4911.                               p^.left^.location.register,R_EAX);
  4912.                        end
  4913.                      else
  4914.                        if is_mem then
  4915.                          floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
  4916.                 end;
  4917. do_jmp:
  4918.               truelabel:=otlabel;
  4919.               falselabel:=oflabel;
  4920.               emitl(A_JMP,aktexit2label);
  4921.            end
  4922.          else
  4923.            begin
  4924.               emitl(A_JMP,aktexitlabel);
  4925.            end;
  4926.        end;
  4927.  
  4928.     procedure secondgoto(var p : ptree);
  4929.  
  4930.        begin
  4931.          emitl(A_JMP,p^.labelnr);
  4932.        end;
  4933.  
  4934.     procedure secondlabel(var p : ptree);
  4935.  
  4936.       begin
  4937.          emitl(A_LABEL,p^.labelnr);
  4938.          cleartempgen;
  4939.          secondpass(p^.left);
  4940.       end;
  4941.  
  4942.     procedure secondasm(var p : ptree);
  4943.  
  4944.       begin
  4945.          exprasmlist^.concatlist(p^.p_asm);
  4946.        end;
  4947.  
  4948.     procedure secondcase(var p : ptree);
  4949.  
  4950.       var
  4951.          with_sign : boolean;
  4952.          opsize : topsize;
  4953.          jmp_gt,jmp_le,jmp_lee : tasmop;
  4954.          hp : ptree;
  4955.          { register with case expression }
  4956.          hregister : tregister;
  4957.          endlabel,elselabel : plabel;
  4958.  
  4959.          { true, if we can omit the range check of the jump table }
  4960.          jumptable_no_range : boolean;
  4961.  
  4962.       procedure gentreejmp(p : pcaserecord);
  4963.  
  4964.         var
  4965.            lesslabel,greaterlabel : plabel;
  4966.  
  4967.        begin
  4968.          emitl(A_LABEL,p^._at);
  4969.          { calculate labels for left and right }
  4970.          if (p^.less=nil) then
  4971.            lesslabel:=elselabel
  4972.          else
  4973.            lesslabel:=p^.less^._at;
  4974.          if (p^.greater=nil) then
  4975.            greaterlabel:=elselabel
  4976.          else
  4977.            greaterlabel:=p^.greater^._at;
  4978.            { calculate labels for left and right }
  4979.          { no range label: }
  4980.          if p^._low=p^._high then
  4981.            begin
  4982.               exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  4983.               if greaterlabel=lesslabel then
  4984.                 begin
  4985.                    emitl(A_JNE,lesslabel);
  4986.                 end
  4987.               else
  4988.                 begin
  4989.                    emitl(jmp_le,lesslabel);
  4990.                    emitl(jmp_gt,greaterlabel);
  4991.                 end;
  4992.               emitl(A_JMP,p^.statement);
  4993.            end
  4994.          else
  4995.            begin
  4996.               exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  4997.               emitl(jmp_le,lesslabel);
  4998.                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^._high,hregister)));
  4999.               emitl(jmp_gt,greaterlabel);
  5000.               emitl(A_JMP,p^.statement);
  5001.            end;
  5002.           if assigned(p^.less) then
  5003.            gentreejmp(p^.less);
  5004.           if assigned(p^.greater) then
  5005.            gentreejmp(p^.greater);
  5006.       end;
  5007.  
  5008.       procedure genlinearlist(hp : pcaserecord);
  5009.  
  5010.         var
  5011.            first : boolean;
  5012.            last : longint;
  5013.            {helplabel : longint;}
  5014.  
  5015.         procedure genitem(t : pcaserecord);
  5016.  
  5017.           begin
  5018.              if assigned(t^.less) then
  5019.                genitem(t^.less);
  5020.              if t^._low=t^._high then
  5021.                begin
  5022.                   if t^._low-last=1 then
  5023.                     exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)))
  5024.                   else if t^._low-last=0 then
  5025.                     exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,opsize,hregister,hregister)))
  5026.                   else
  5027.                     exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  5028.                   last:=t^._low;
  5029.  
  5030.                   emitl(A_JZ,t^.statement);
  5031.                end
  5032.              else
  5033.                begin
  5034.                   { it begins with the smallest label, if the value }
  5035.                   { is even smaller then jump immediately to the    }
  5036.                   { ELSE-label                                      }
  5037.                   if first then
  5038.                     begin
  5039.                        if t^._low-1=1 then
  5040.                          exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
  5041.                            hregister)))
  5042.                        else if t^._low-1=0 then
  5043.                          exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,opsize,
  5044.                            hregister,hregister)))
  5045.                        else
  5046.                          exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,
  5047.                            t^._low-1,hregister)));
  5048.                        { work around: if the lower range=0 and we
  5049.                          do the subtraction we have to take care
  5050.                          of the sign!
  5051.                        }
  5052.                        if t^._low=0 then
  5053.                          emitl(A_JLE,elselabel)
  5054.                        else
  5055.                          emitl(jmp_lee,elselabel);
  5056.                     end
  5057.                   { if there is no unused label between the last and the }
  5058.                   { present label then the lower limit can be checked    }
  5059.                   { immediately. else check the range in between:        }
  5060.                   else if (t^._low-last>1)then
  5061.                     begin
  5062.                        if t^._low-last-1=1 then
  5063.                          exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,hregister)))
  5064.                        else
  5065.                          exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
  5066.                        emitl(jmp_lee,elselabel);
  5067.                     end;
  5068.                   exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
  5069.                   emitl(jmp_lee,t^.statement);
  5070.  
  5071.                   last:=t^._high;
  5072.                end;
  5073.              first:=false;
  5074.              if assigned(t^.greater) then
  5075.                genitem(t^.greater);
  5076.           end;
  5077.  
  5078.         var
  5079.            hr : tregister;
  5080.  
  5081.           begin
  5082.              { case register is modified by the list evalution }
  5083.            if (p^.left^.location.loc=LOC_CREGISTER) then
  5084.              begin
  5085.                 hr:=getregister32;
  5086.                 case opsize of
  5087.                    S_B : hregister:=reg32toreg8(hr);
  5088.                    S_W : hregister:=reg32toreg16(hr);
  5089.                    S_L : hregister:=hr;
  5090.                 end;
  5091.              end;
  5092.            last:=0;
  5093.            first:=true;
  5094.            genitem(hp);
  5095.            emitl(A_JMP,elselabel);
  5096.         end;
  5097.  
  5098.       procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  5099.  
  5100.         var
  5101.            table : plabel;
  5102.            last : longint;
  5103.            hr : preference;
  5104.  
  5105.         procedure genitem(t : pcaserecord);
  5106.  
  5107.           var
  5108.              i : longint;
  5109.  
  5110.           begin
  5111.              if assigned(t^.less) then
  5112.                genitem(t^.less);
  5113.              { fill possible hole }
  5114.              for i:=last+1 to t^._low-1 do
  5115.                datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  5116.                  (elselabel)))));
  5117.              for i:=t^._low to t^._high do
  5118.                datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  5119.                     (t^.statement)))));
  5120.               last:=t^._high;
  5121.              if assigned(t^.greater) then
  5122.                genitem(t^.greater);
  5123.             end;
  5124.  
  5125.           begin
  5126.            if not(jumptable_no_range) then
  5127.              begin
  5128.                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,min_,hregister)));
  5129.                 { case expr less than min_ => goto elselabel }
  5130.                 emitl(jmp_le,elselabel);
  5131.                 exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,max_,hregister)));
  5132.                 emitl(jmp_gt,elselabel);
  5133.              end;
  5134.            getlabel(table);
  5135.            { extend with sign }
  5136.            if opsize=S_W then
  5137.              begin
  5138.                 exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,hregister,
  5139.                   reg16toreg32(hregister))));
  5140.                 hregister:=reg16toreg32(hregister);
  5141.              end
  5142.            else if opsize=S_B then
  5143.              begin
  5144.                 exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,
  5145.                   reg8toreg32(hregister))));
  5146.                 hregister:=reg8toreg32(hregister);
  5147.              end;
  5148.            new(hr);
  5149.            reset_reference(hr^);
  5150.            hr^.symbol:=stringdup(lab2str(table));
  5151.            hr^.offset:=(-min_)*4;
  5152.            hr^.index:=hregister;
  5153.            hr^.scalefactor:=4;
  5154.            exprasmlist^.concat(new(pai386,op_ref(A_JMP,S_NO,hr)));
  5155.            { !!!!! generate tables
  5156.              if not(cs_littlesize in aktswitches^ ) then
  5157.              datasegment^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  5158.            }
  5159.            datasegment^.concat(new(pai_label,init(table)));
  5160.              last:=min_;
  5161.            genitem(hp);
  5162.              { !!!!!!!
  5163.            if not(cs_littlesize in aktswitches^ ) then
  5164.              exprasmlist^.concat(new(pai386,op_const(A_ALIGN,S_NO,4)));
  5165.            }
  5166.         end;
  5167.  
  5168.       var
  5169.          lv,hv,min_label,max_label,labels : longint;
  5170.          max_linear_list : longint;
  5171.  
  5172.       begin
  5173.          getlabel(endlabel);
  5174.          getlabel(elselabel);
  5175.          with_sign:=is_signed(p^.left^.resulttype);
  5176.          if with_sign then
  5177.            begin
  5178.               jmp_gt:=A_JG;
  5179.               jmp_le:=A_JL;
  5180.               jmp_lee:=A_JLE;
  5181.            end
  5182.          else
  5183.             begin
  5184.               jmp_gt:=A_JA;
  5185.               jmp_le:=A_JB;
  5186.               jmp_lee:=A_JBE;
  5187.            end;
  5188.          cleartempgen;
  5189.          secondpass(p^.left);
  5190.          { determines the size of the operand }
  5191.          { determines the size of the operand }
  5192.          opsize:=bytes2Sxx[p^.left^.resulttype^.size];
  5193.          { copy the case expression to a register }
  5194.          { copy the case expression to a register }
  5195.          case p^.left^.location.loc of
  5196.             LOC_REGISTER,
  5197.             LOC_CREGISTER:
  5198.               hregister:=p^.left^.location.register;
  5199.             LOC_MEM,LOC_REFERENCE : begin
  5200.                                        del_reference(p^.left^.location.reference);
  5201.                                            hregister:=getregister32;
  5202.                                        case opsize of
  5203.                                           S_B : hregister:=reg32toreg8(hregister);
  5204.                                           S_W : hregister:=reg32toreg16(hregister);
  5205.                                        end;
  5206.                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(
  5207.                                          p^.left^.location.reference),hregister)));
  5208.                                     end;
  5209.             else internalerror(2002);
  5210.          end;
  5211.          { now generate the jumps }
  5212.            if cs_optimize in aktswitches then
  5213.            begin
  5214.               { procedures are empirically passed on }
  5215.               { consumption can also be calculated   }
  5216.               { but does it pay on the different     }
  5217.               { processors?                          }
  5218.               { moreover can the size only be appro- }
  5219.               { ximated as it is not known if rel8,  }
  5220.               { rel16 or rel32 jumps are used        }
  5221.               min_label:=case_get_min(p^.nodes);
  5222.               max_label:=case_get_max(p^.nodes);
  5223.               labels:=case_count_labels(p^.nodes);
  5224.               { can we omit the range check of the jump table }
  5225.               getrange(p^.left^.resulttype,lv,hv);
  5226.               jumptable_no_range:=(lv=min_label) and (hv=max_label);
  5227.  
  5228.               { optimize for size ? }
  5229.               if cs_littlesize in aktswitches  then
  5230.                 begin
  5231.                    if (labels<=2) or ((max_label-min_label)>3*labels) then
  5232.                   { a linear list is always smaller than a jump tree }
  5233.                      genlinearlist(p^.nodes)
  5234.                    else
  5235.                           { if the labels less or more a continuum then }
  5236.                           genjumptable(p^.nodes,min_label,max_label);
  5237.                 end
  5238.               else
  5239.                 begin
  5240.                    if jumptable_no_range then
  5241.                      max_linear_list:=4
  5242.                    else
  5243.                      max_linear_list:=2;
  5244.                    { a jump table crashes the pipeline! }
  5245.                    if opt_processors=i486 then
  5246.                      inc(max_linear_list,3);
  5247.                        if opt_processors=pentium then
  5248.                      inc(max_linear_list,6);
  5249.                    if opt_processors=pentiumpro then
  5250.                      inc(max_linear_list,9);
  5251.  
  5252.                    if (labels<=max_linear_list) then
  5253.                      genlinearlist(p^.nodes)
  5254.                    else
  5255.                      begin
  5256.                         if ((max_label-min_label)>4*labels) then
  5257.                           begin
  5258.                              if labels>16 then
  5259.                                gentreejmp(p^.nodes)
  5260.                              else
  5261.                                genlinearlist(p^.nodes);
  5262.                           end
  5263.                         else
  5264.                           genjumptable(p^.nodes,min_label,max_label);
  5265.                      end;
  5266.                 end;
  5267.              end
  5268.            else
  5269.            { it's always not bad }
  5270.            genlinearlist(p^.nodes);
  5271.  
  5272.          { now generate the instructions }
  5273.            hp:=p^.right;
  5274.          while assigned(hp) do
  5275.            begin
  5276.               cleartempgen;
  5277.               secondpass(hp^.right);
  5278.               emitl(A_JMP,endlabel);
  5279.               hp:=hp^.left;
  5280.            end;
  5281.          emitl(A_LABEL,elselabel);
  5282.          { ...and the else block }
  5283.          if assigned(p^.elseblock) then
  5284.              begin
  5285.               cleartempgen;
  5286.               secondpass(p^.elseblock);
  5287.            end;
  5288.          emitl(A_LABEL,endlabel);
  5289.       end;
  5290.  
  5291.     { generates the code for a raise statement }
  5292.     procedure secondraise(var p : ptree);
  5293.  
  5294.       var
  5295.          a : plabel;
  5296.  
  5297.       begin
  5298.          if assigned(p^.left) then
  5299.            begin
  5300.               { generate the address }
  5301.               if assigned(p^.right) then
  5302.                 begin
  5303.                    secondpass(p^.right);
  5304.                        if codegenerror then
  5305.                           exit;
  5306.                 end
  5307.               else
  5308.                         begin
  5309.                    getlabel(a);
  5310.                            emitl(A_LABEL,a);
  5311.                    exprasmlist^.concat(new(pai386,
  5312.                      op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(a),0))));
  5313.                 end;
  5314.               secondpass(p^.left);
  5315.               if codegenerror then
  5316.                 exit;
  5317.  
  5318.               case p^.left^.location.loc of
  5319.                  LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
  5320.                  LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  5321.                        p^.left^.location.register)));
  5322.                  else Message(sym_e_type_mismatch);
  5323.               end;
  5324.                  emitcall('DO_RAISE',true);
  5325.              end
  5326.            else
  5327.              emitcall('DO_RERAISE',true);
  5328.        end;
  5329.  
  5330.      procedure secondtryexcept(var p : ptree);
  5331.  
  5332.       begin
  5333.       end;
  5334.  
  5335.     procedure secondtryfinally(var p : ptree);
  5336.  
  5337.       begin
  5338.       end;
  5339.  
  5340.      procedure secondfail(var p : ptree);
  5341.  
  5342.       var hp : preference;
  5343.  
  5344.       begin
  5345.          {if procinfo.exceptions then
  5346.            aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
  5347.          else }
  5348.          { we should know if the constructor is called with a new or not,
  5349.          how can we do that ???
  5350.          exprasmlist^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
  5351.          }
  5352.          exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  5353.          { also reset to zero in the stack }
  5354.          new(hp);
  5355.          reset_reference(hp^);
  5356.          hp^.offset:=procinfo.ESI_offset;
  5357.          hp^.base:=procinfo.framepointer;
  5358.          exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_ESI,hp)));
  5359.          exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
  5360.       end;
  5361.  
  5362.      procedure secondwith(var p : ptree);
  5363.  
  5364.         var
  5365.             ref : treference;
  5366.           symtable : psymtable;
  5367.           i : longint;
  5368.  
  5369.       begin
  5370.          if assigned(p^.left) then
  5371.             begin
  5372.                secondpass(p^.left);
  5373.                ref.symbol:=nil;
  5374.                gettempofsizereference(4,ref);
  5375.                exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  5376.                  newreference(p^.left^.location.reference),R_EDI)));
  5377.                exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  5378.                  R_EDI,newreference(ref))));
  5379.                del_reference(p^.left^.location.reference);
  5380.                { the offset relative to (%ebp) is only needed here! }
  5381.                symtable:=p^.withsymtable;
  5382.                for i:=1 to p^.tablecount do
  5383.                  begin
  5384.                     symtable^.datasize:=ref.offset;
  5385.                     symtable:=symtable^.next;
  5386.                  end;
  5387.  
  5388.                { p^.right can be optimize out !!! }
  5389.                if p^.right<>nil then
  5390.                  secondpass(p^.right);
  5391.                { clear some stuff }
  5392.                ungetiftemp(ref);
  5393.             end;
  5394.        end;
  5395.  
  5396.      procedure secondpass(var p : ptree);
  5397.  
  5398.        const
  5399.            procedures : array[ttreetyp] of secondpassproc =
  5400.                (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
  5401.                 secondmoddiv,secondassignment,secondload,secondnothing,
  5402.                 secondadd,secondadd,secondadd,secondadd,
  5403.                 secondadd,secondadd,secondin,secondadd,
  5404.                 secondadd,secondshlshr,secondshlshr,secondadd,
  5405.                secondadd,secondsubscriptn,secondderef,secondaddr,
  5406.              seconddoubleaddr,
  5407.              secondordconst,secondtypeconv,secondcalln,secondnothing,
  5408.              secondrealconst,secondfixconst,secondumminus,
  5409.              secondasm,secondvecn,
  5410.              secondstringconst,secondfuncret,secondselfn,
  5411.              secondnot,secondinline,secondniln,seconderror,
  5412.              secondnothing,secondhnewn,secondhdisposen,secondnewn,
  5413.              secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
  5414.              secondnothing,secondnothing,secondifn,secondbreakn,
  5415.              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
  5416.              secondexitn,secondwith,secondcase,secondlabel,
  5417.              secondgoto,secondsimplenewdispose,secondtryexcept,secondraise,
  5418.              secondnothing,secondtryfinally,secondis,secondas,seconderror,
  5419.              secondfail,
  5420.              secondnothing,secondloadvmt);
  5421.       var
  5422.          oldcodegenerror : boolean;
  5423.          oldswitches : Tcswitches;
  5424.          oldis : pinputfile;
  5425.          oldnr : longint;
  5426.  
  5427.       begin
  5428.          oldcodegenerror:=codegenerror;
  5429.          oldswitches:=aktswitches;
  5430.            oldis:=current_module^.current_inputfile;
  5431.             oldnr:=current_module^.current_inputfile^.line_no;
  5432.  
  5433.          codegenerror:=false;
  5434.            current_module^.current_inputfile:=p^.inputfile;
  5435.          current_module^.current_inputfile^.line_no:=p^.line;
  5436.          aktswitches:=p^.pragmas;
  5437.          if not(p^.error) then
  5438.            begin
  5439.               procedures[p^.treetype](p);
  5440.               p^.error:=codegenerror;
  5441.                  codegenerror:=codegenerror or oldcodegenerror;
  5442.            end
  5443.          else codegenerror:=true;
  5444.          aktswitches:=oldswitches;
  5445.            current_module^.current_inputfile:=oldis;
  5446.          current_module^.current_inputfile^.line_no:=oldnr;
  5447.       end;
  5448.  
  5449.     function do_secondpass(var p : ptree) : boolean;
  5450.  
  5451.       begin
  5452.          codegenerror:=false;
  5453.          if not(p^.error) then
  5454.            secondpass(p);
  5455.          do_secondpass:=codegenerror;
  5456.       end;
  5457.  
  5458.     var
  5459.        regvars : array[1..maxvarregs] of pvarsym;
  5460.        regvars_para : array[1..maxvarregs] of boolean;
  5461.        regvars_refs : array[1..maxvarregs] of longint;
  5462.        parasym : boolean;
  5463.  
  5464.     procedure searchregvars(p : psym);
  5465.  
  5466.       var
  5467.          i,j,k : longint;
  5468.  
  5469.       begin
  5470.          if (p^.typ=varsym) and (pvarsym(p)^.regable) then
  5471.            begin
  5472.               { walk through all momentary register variables }
  5473.               for i:=1 to maxvarregs do
  5474.                 begin
  5475.                    { free register ? }
  5476.                    if regvars[i]=nil then
  5477.                      begin
  5478.                         regvars[i]:=pvarsym(p);
  5479.                         regvars_para[i]:=parasym;
  5480.                         break;
  5481.                      end;
  5482.                    { else throw out a variable ? }
  5483.                        j:=pvarsym(p)^.refs;
  5484.                    { parameter get a less value }
  5485.                    if parasym then
  5486.                      begin
  5487.                         if cs_littlesize in aktswitches  then
  5488.                           dec(j,1)
  5489.                         else
  5490.                           dec(j,100);
  5491.                      end;
  5492.                    if (j>regvars_refs[i]) and (j>0) then
  5493.                      begin
  5494.                         for k:=maxvarregs-1 downto i do
  5495.                           begin
  5496.                              regvars[k+1]:=regvars[k];
  5497.                              regvars_para[k+1]:=regvars_para[k];
  5498.                           end;
  5499.                         { calc the new refs
  5500.                         pvarsym(p)^.refs:=j; }
  5501.                         regvars[i]:=pvarsym(p);
  5502.                         regvars_para[i]:=parasym;
  5503.                         regvars_refs[i]:=j;
  5504.                         break;
  5505.                      end;
  5506.                 end;
  5507.            end;
  5508.       end;
  5509.  
  5510.     procedure generatecode(var p : ptree);
  5511.  
  5512.       var
  5513.            { *pass modifies with every node aktlinenr and current_module^.current_inputfile, }
  5514.          { to constantly contain the right line numbers             }
  5515.            oldis : pinputfile;
  5516.          oldnr,i : longint;
  5517.          regsize : topsize;
  5518.          regi : tregister;
  5519.           hr : preference;
  5520.  
  5521.        label
  5522.          nextreg;
  5523.  
  5524.       begin
  5525.          cleartempgen;
  5526.          oldis:=current_module^.current_inputfile;
  5527.          oldnr:=current_module^.current_inputfile^.line_no;
  5528.          { when size optimization only count occurrence }
  5529.          if cs_littlesize in aktswitches then
  5530.            t_times:=1
  5531.          else
  5532.            { reference for repetition is 100 }
  5533.            t_times:=100;
  5534.          { clear register count }
  5535. {$ifdef SUPPORT_MMX}
  5536.          for regi:=R_EAX to R_MM6 do
  5537.            begin
  5538.               reg_pushes[regi]:=0;
  5539.               is_reg_var[regi]:=false;
  5540.            end;
  5541. {$else SUPPORT_MMX}
  5542.          for regi:=R_EAX to R_EDI do
  5543.            begin
  5544.               reg_pushes[regi]:=0;
  5545.               is_reg_var[regi]:=false;
  5546.            end;
  5547. {$endif SUPPORT_MMX}
  5548.          use_esp_stackframe:=false;
  5549.  
  5550.          if not(do_firstpass(p)) then
  5551.            begin
  5552.               { max. optimizations     }
  5553.               { only if no asm is used }
  5554.               if (cs_maxoptimieren in aktswitches) and
  5555.                 ((procinfo.flags and pi_uses_asm)=0) then
  5556.                 begin
  5557.                    { can we omit the stack frame ? }
  5558.                    { conditions:
  5559.                      1. procedure (not main block)
  5560.                      2. no constructor or destructor
  5561.                      3. no call to other procedures
  5562.                      4. no interrupt handler
  5563.                    }
  5564.                    if assigned(aktprocsym) then
  5565.                      begin
  5566.                        if (aktprocsym^.definition^.options and
  5567.                         poconstructor+podestructor+poinline+pointerrupt=0) and
  5568.                         ((procinfo.flags and pi_do_call)=0) and (lexlevel>1) then
  5569.                        begin
  5570.                          { use ESP as frame pointer }
  5571.                          procinfo.framepointer:=R_ESP;
  5572.                          use_esp_stackframe:=true;
  5573.  
  5574.                          { calc parameter distance new }
  5575.                          dec(procinfo.framepointer_offset,4);
  5576.                          dec(procinfo.ESI_offset,4);
  5577.  
  5578.                          dec(procinfo.retoffset,4);
  5579.  
  5580.                          dec(procinfo.call_offset,4);
  5581.                          aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
  5582.                        end;
  5583.                      end;
  5584.                    if (p^.registers32<4) then
  5585.                        begin
  5586.                         for i:=1 to maxvarregs do
  5587.                           regvars[i]:=nil;
  5588.                         parasym:=false;
  5589. {$ifdef tp}
  5590.                         symtablestack^.foreach(searchregvars);
  5591. {$else}
  5592.                         symtablestack^.foreach(@searchregvars);
  5593. {$endif}
  5594.                         { copy parameter into a register ? }
  5595.                         parasym:=true;
  5596. {$ifdef tp}
  5597.                         symtablestack^.next^.foreach(searchregvars);
  5598. {$else}
  5599.                         symtablestack^.next^.foreach(@searchregvars);
  5600. {$endif}
  5601.  
  5602.                         { hold needed registers free }
  5603.                         for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  5604.                           regvars[i]:=nil;
  5605.                         { now assign register }
  5606.                         for i:=1 to maxvarregs-p^.registers32 do
  5607.                           begin
  5608.                              if assigned(regvars[i]) then
  5609.                                begin
  5610.                                   { it is nonsens, to copy the variable to }
  5611.                                   { a register because we need then much   }
  5612.                                   { pushes ?                               }
  5613.                                   if reg_pushes[varregs[i]]>=regvars[i]^.refs then
  5614.                                     begin
  5615.                                        regvars[i]:=nil;
  5616.                                        goto nextreg;
  5617.                                     end;
  5618.  
  5619.                                   { register is no longer available for }
  5620.                                   { expressions                         }
  5621.                                   { search the register which is the most }
  5622.                                   { unused                                }
  5623.                                   usableregs:=usableregs-[varregs[i]];
  5624.                                   is_reg_var[varregs[i]]:=true;
  5625.                                   dec(c_usableregs);
  5626.  
  5627.                                   { possibly no 32 bit register are needed }
  5628.                                   if  (regvars[i]^.definition^.deftype=orddef) and
  5629.                                       (
  5630.                                        (porddef(regvars[i]^.definition)^.typ=bool8bit) or
  5631.                                        (porddef(regvars[i]^.definition)^.typ=uchar) or
  5632.                                        (porddef(regvars[i]^.definition)^.typ=u8bit) or
  5633.                                        (porddef(regvars[i]^.definition)^.typ=s8bit)
  5634.                                       ) then
  5635.                                     begin
  5636.                                        regvars[i]^.reg:=reg32toreg8(varregs[i]);
  5637.                                        regsize:=S_B;
  5638.                                     end
  5639.                                   else if  (regvars[i]^.definition^.deftype=orddef) and
  5640.                                       (
  5641.                                        (porddef(regvars[i]^.definition)^.typ=u16bit) or
  5642.                                        (porddef(regvars[i]^.definition)^.typ=s16bit)
  5643.                                       ) then
  5644.                                     begin
  5645.                                        regvars[i]^.reg:=reg32toreg16(varregs[i]);
  5646.                                        regsize:=S_W;
  5647.                                     end
  5648.                                   else
  5649.                                     begin
  5650.                                        regvars[i]^.reg:=varregs[i];
  5651.                                        regsize:=S_L;
  5652.                                     end;
  5653.                                   { parameter must be load }
  5654.                                   if regvars_para[i] then
  5655.                                     begin
  5656.                                        { procinfo is there actual,      }
  5657.                                        { because we can't never be in a }
  5658.                                        { nested procedure               }
  5659.                                        { when loading parameter to reg  }
  5660.                                        new(hr);
  5661.                                        reset_reference(hr^);
  5662.                                        hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  5663.                                        hr^.base:=procinfo.framepointer;
  5664.                                        procinfo.aktentrycode^.concat(new(pai386,op_ref_reg(A_MOV,regsize,
  5665.                                          hr,regvars[i]^.reg)));
  5666.                                        unused:=unused - [regvars[i]^.reg];
  5667.                                     end;
  5668.                                   { procedure uses this register }
  5669.                                   usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  5670.                                end;
  5671.                              nextreg:
  5672.                                { dummy }
  5673.                                regsize:=S_W;
  5674.                           end;
  5675.                         if (verbosity and v_debug)=v_debug then
  5676.                           begin
  5677.                              for i:=1 to maxvarregs do
  5678.                                begin
  5679.                                   if assigned(regvars[i]) then
  5680.                                    Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  5681.                                            tostr(regvars[i]^.refs),regvars[i]^.name);
  5682.                                end;
  5683.                           end;
  5684.                      end;
  5685.                 end;
  5686.               do_secondpass(p);
  5687.  
  5688.               { all registers can be used again }
  5689.               usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
  5690. {$ifdef SUPPORT_MMX}
  5691.               usableregs:=usableregs+[R_MM0..R_MM6];
  5692. {$endif SUPPORT_MMX}
  5693.               c_usableregs:=4;
  5694.            end;
  5695.          procinfo.aktproccode^.concatlist(exprasmlist);
  5696.  
  5697.          current_module^.current_inputfile:=oldis;
  5698.          current_module^.current_inputfile^.line_no:=oldnr;
  5699.       end;
  5700.  
  5701. end.
  5702. {
  5703.   $Log: cgi386.pas,v $
  5704.   Revision 1.3.2.2  1998/08/18 13:48:34  carl
  5705.     + Analizeset for big endian machines
  5706.  
  5707.   Revision 1.3.2.1  1998/07/29 12:22:49  carl
  5708.     * bug0130, bug0134 and bug0129 fixed
  5709.  
  5710.   Revision 1.3  1998/03/28 23:09:55  florian
  5711.     * secondin bugfix (m68k and i386)
  5712.     * overflow checking bugfix (m68k and i386) -- pretty useless in
  5713.       secondadd, since everything is done using 32-bit
  5714.     * loading pointer to routines hopefully fixed (m68k)
  5715.     * flags problem with calls to RTL internal routines fixed (still strcmp
  5716.       to fix) (m68k)
  5717.     * #ELSE was still incorrect (didn't take care of the previous level)
  5718.     * problem with filenames in the command line solved
  5719.     * problem with mangledname solved
  5720.     * linking name problem solved (was case insensitive)
  5721.     * double id problem and potential crash solved
  5722.     * stop after first error
  5723.     * and=>test problem removed
  5724.     * correct read for all float types
  5725.     * 2 sigsegv fixes and a cosmetic fix for Internal Error
  5726.     * push/pop is now correct optimized (=> mov (%esp),reg)
  5727.  
  5728.   Revision 1.2  1998/03/26 11:18:30  florian
  5729.     - switch -Sa removed
  5730.     - support of a:=b:=0 removed
  5731.  
  5732.   Revision 1.1.1.1  1998/03/25 11:18:13  root
  5733.   * Restored version
  5734.  
  5735.   Revision 1.58  1998/03/24 21:48:30  florian
  5736.     * just a couple of fixes applied:
  5737.          - problem with fixed16 solved
  5738.          - internalerror 10005 problem fixed
  5739.          - patch for assembler reading
  5740.          - small optimizer fix
  5741.          - mem is now supported
  5742.  
  5743.   Revision 1.57  1998/03/16 22:42:19  florian
  5744.     * some fixes of Peter applied:
  5745.       ofs problem, profiler support
  5746.  
  5747.   Revision 1.56  1998/03/13 22:45:57  florian
  5748.     * small bug fixes applied
  5749.  
  5750.   Revision 1.55  1998/03/11 22:22:51  florian
  5751.     * Fixed circular unit uses, when the units are not in the current dir (from Peter)
  5752.     * -i shows correct info, not <lf> anymore (from Peter)
  5753.     * linking with shared libs works again (from Peter)
  5754.  
  5755.   Revision 1.54  1998/03/10 23:48:35  florian
  5756.     * a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
  5757.       enough, it doesn't run
  5758.  
  5759.   Revision 1.53  1998/03/10 16:27:37  pierre
  5760.     * better line info in stabs debug
  5761.     * symtabletype and lexlevel separated into two fields of tsymtable
  5762.     + ifdef MAKELIB for direct library output, not complete
  5763.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  5764.       working
  5765.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  5766.       working
  5767.  
  5768.   Revision 1.52  1998/03/10 01:17:16  peter
  5769.     * all files have the same header
  5770.     * messages are fully implemented, EXTDEBUG uses Comment()
  5771.     + AG... files for the Assembler generation
  5772.  
  5773.   Revision 1.51  1998/03/09 10:44:37  peter
  5774.     + string='', string<>'', string:='', string:=char optimizes (the first 2
  5775.       were already in cg68k2)
  5776.  
  5777.   Revision 1.50  1998/03/06 00:52:10  peter
  5778.     * replaced all old messages from errore.msg, only ExtDebug and some
  5779.       Comment() calls are left
  5780.     * fixed options.pas
  5781.  
  5782.   Revision 1.49  1998/03/04 01:34:56  peter
  5783.     * messages for unit-handling and assembler/linker
  5784.     * the compiler compiles without -dGDB, but doesn't work yet
  5785.     + -vh for Hint
  5786.  
  5787.   Revision 1.48  1998/03/03 20:36:51  florian
  5788.     * bug in second_smaller fixed
  5789.  
  5790.   Revision 1.47  1998/03/03 01:08:24  florian
  5791.     * bug0105 and bug0106 problem solved
  5792.  
  5793.   Revision 1.46  1998/03/02 01:48:24  peter
  5794.     * renamed target_DOS to target_GO32V1
  5795.     + new verbose system, merged old errors and verbose units into one new
  5796.       verbose.pas, so errors.pas is obsolete
  5797.  
  5798.   Revision 1.45  1998/03/01 22:46:06  florian
  5799.     + some win95 linking stuff
  5800.     * a couple of bugs fixed:
  5801.       bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
  5802.  
  5803.   Revision 1.44  1998/02/24 16:49:57  peter
  5804.     * stackframe ommiting generated 'ret $-4'
  5805.     + timer.pp bp7 version
  5806.     * innr.inc are now the same files
  5807.  
  5808.   Revision 1.43  1998/02/22 23:03:12  peter
  5809.     * renamed msource->mainsource and name->unitname
  5810.     * optimized filename handling, filename is not seperate anymore with
  5811.       path+name+ext, this saves stackspace and a lot of fsplit()'s
  5812.     * recompiling of some units in libraries fixed
  5813.     * shared libraries are working again
  5814.     + $LINKLIB <lib> to support automatic linking to libraries
  5815.     + libraries are saved/read from the ppufile, also allows more libraries
  5816.       per ppufile
  5817.  
  5818.   Revision 1.42  1998/02/21 04:09:13  carl
  5819.     * stupid syntax error fix
  5820.  
  5821.   Revision 1.41  1998/02/20 20:35:14  carl
  5822.     * Fixed entry and exit code which was ALL messed up
  5823.  
  5824.   Revision 1.40  1998/02/19 12:15:08  daniel
  5825.   * Optimized a statement that did pain to my eyes.
  5826.  
  5827.   Revision 1.39  1998/02/17 21:20:40  peter
  5828.     + Script unit
  5829.     + __EXIT is called again to exit a program
  5830.     - target_info.link/assembler calls
  5831.     * linking works again for dos
  5832.     * optimized a few filehandling functions
  5833.     * fixed stabs generation for procedures
  5834.  
  5835.   Revision 1.38  1998/02/15 21:16:12  peter
  5836.     * all assembler outputs supported by assemblerobject
  5837.     * cleanup with assembleroutputs, better .ascii generation
  5838.     * help_constructor/destructor are now added to the externals
  5839.     - generation of asmresponse is not outputformat depended
  5840.  
  5841.   Revision 1.37  1998/02/14 01:45:15  peter
  5842.     * more fixes
  5843.     - pmode target is removed
  5844.     - search_as_ld is removed, this is done in the link.pas/assemble.pas
  5845.     + findexe() to search for an executable (linker,assembler,binder)
  5846.  
  5847.   Revision 1.36  1998/02/13 22:26:19  peter
  5848.     * fixed a few SigSegv's
  5849.     * INIT$$ was not written for linux!
  5850.     * assembling and linking works again for linux and dos
  5851.     + assembler object, only attasmi3 supported yet
  5852.     * restore pp.pas with AddPath etc.
  5853.  
  5854.   Revision 1.35  1998/02/13 10:34:50  daniel
  5855.   * Made Motorola version compilable.
  5856.   * Fixed optimizer
  5857.  
  5858.   Revision 1.34  1998/02/12 17:18:57  florian
  5859.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  5860.       also that aktswitches isn't a pointer)
  5861.  
  5862.   Revision 1.33  1998/02/12 11:49:56  daniel
  5863.   Yes! Finally! After three retries, my patch!
  5864.  
  5865.   Changes:
  5866.  
  5867.   Complete rewrite of psub.pas.
  5868.   Added support for DLL's.
  5869.   Compiler requires less memory.
  5870.   Platform units for each platform.
  5871.  
  5872.   Revision 1.23  1998/02/01 19:39:50  florian
  5873.     * clean up
  5874.     * bug0029 fixed
  5875.  
  5876.   Revision 1.22  1998/01/27 22:02:29  florian
  5877.     * small bug fix to the compiler work, I forgot a not(...):(
  5878.  
  5879.   Revision 1.21  1998/01/27 10:49:15  florian
  5880.   *** empty log message ***
  5881.  
  5882.   Revision 1.20  1998/01/26 17:29:14  florian
  5883.     * Peter's fix for bug0046 applied
  5884.  
  5885.   Revision 1.19  1998/01/25 22:28:55  florian
  5886.     * a lot bug fixes on the DOM
  5887.  
  5888.   Revision 1.18  1998/01/21 21:29:50  florian
  5889.     * some fixes for Delphi classes
  5890.  
  5891.   Revision 1.17  1998/01/20 23:53:04  carl
  5892.     * bugfix 74 (FINAL, the one from Pierre was incomplete under BP)
  5893.  
  5894.   Revision 1.16  1998/01/19 10:25:14  pierre
  5895.     * bug in object function call in main program or unit init fixed
  5896.  
  5897.   Revision 1.15  1998/01/16 22:34:29  michael
  5898.   * Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
  5899.     in this compiler :)
  5900.  
  5901.   Revision 1.14  1998/01/16 18:03:11  florian
  5902.     * small bug fixes, some stuff of delphi styled constructores added
  5903.  
  5904.   Revision 1.13  1998/01/13 23:11:05  florian
  5905.     + class methods
  5906.  
  5907.   Revision 1.12  1998/01/07 00:16:44  michael
  5908.   Restored released version (plus fixes) as current
  5909.  
  5910.   Revision 1.10  1997/12/13 18:59:42  florian
  5911.   + I/O streams are now also declared as external, if neccessary
  5912.   * -Aobj generates now a correct obj file via nasm
  5913.  
  5914.   Revision 1.9  1997/12/10 23:07:16  florian
  5915.   * bugs fixed: 12,38 (also m68k),39,40,41
  5916.   + warning if a system unit is without -Us compiled
  5917.   + warning if a method is virtual and private (was an error)
  5918.   * some indentions changed
  5919.   + factor does a better error recovering (omit some crashes)
  5920.   + problem with @type(x) removed (crashed the compiler)
  5921.  
  5922.   Revision 1.8  1997/12/09 13:35:47  carl
  5923.   + renamed pai_labeled386 to pai_labeled
  5924.   + renamed S_T to S_X
  5925.  
  5926.   Revision 1.7  1997/12/04 10:39:11  pierre
  5927.     + secondadd separated in file cgi386ad.inc
  5928.  
  5929.   Revision 1.5  1997/11/29 15:41:45  florian
  5930.   only small changes
  5931.  
  5932.   Revision 1.3  1997/11/28 15:43:15  florian
  5933.   Fixed stack ajustment bug, 0.9.8 compiles now 0.9.8 without problems.
  5934.  
  5935.   Revision 1.2  1997/11/28 14:26:19  florian
  5936.   Fixed some bugs
  5937.  
  5938.   Revision 1.1.1.1  1997/11/27 08:32:54  michael
  5939.   FPC Compiler CVS start
  5940.  
  5941.  
  5942.   Pre-CVS log:
  5943.  
  5944.   FK     Florian Klaempfl
  5945.   PM     Pierre Muller
  5946.   +      feature added
  5947.   -      removed
  5948.   *      bug fixed or changed
  5949.  
  5950.   History (started with version 0.9.0):
  5951.       23th october 1996:
  5952.            + some emit calls replaced (FK)
  5953.       24th october 1996:
  5954.          * for bug fixed (FK)
  5955.       26th october 1996:
  5956.          * english comments (FK)
  5957.        5th november 1996:
  5958.          * new init and terminate code (FK)
  5959.  
  5960.       ...... some items missed
  5961.  
  5962.       19th september 1997:
  5963.          * a call to a function procedure a;[ C ]; doesn't crash the stack
  5964.            furthermore (FK)
  5965.          * bug in var_reg assignment fixed
  5966.            did not keep p^.register32 registers free ! (PM)
  5967.       22th september 1997:
  5968.          * stack layout for nested procedures in methods modified:
  5969.            ESI is no more pushed (must be loaded via framepointer) (FK)
  5970.       24th september 1997:
  5971.          + strings constants in consts list to check for existing strings (PM)
  5972.       24th september 1997:
  5973.          * constructor bug removed (FK)
  5974.          * source splitted (into cgi386 and cgi3862 for FPC) (FK)
  5975.          * line_no and inputfile are now in secondpass saved (FK)
  5976.          * patching error removed (the switch -Ox was always used
  5977.            because of a misplaced end) (FK)
  5978.          + strings constants in consts list to check for existing strings (PM)
  5979.       25th september 1997:
  5980.          + secondload provides now the informations for open arrays (FK)
  5981.          + support of high for open arrays (FK)
  5982.          + the high parameter is now pushed for open arrays (FK)
  5983.       3th october 1997:
  5984.          + function second_bool_to_byte for ord(boolean) (PM)
  5985.       4th october 1997:
  5986.          + code for in_pred_x in_succ_x no bound check (PM)
  5987.       13th october 1997:
  5988.          + added code for static modifier for objects variables and methods (PM)
  5989.       14th october 1997:
  5990.          + second_bool_to_byte handles now also LOC_JUMP (FK)
  5991.       28th october 1997:
  5992.          * in secondcallparan bug with param from read/write while nil defcoll^.data
  5993.            fixed (PM)
  5994.       3rd november 1997:
  5995.          + added code for symdif for sets (PM)
  5996.       28th october 1997:
  5997.          * in secondcallparan bug with param from read/write while nil defcoll^.data
  5998.            fixed (PM)
  5999.       3rd november 1997:
  6000.          + added code for symdif for sets (PM)
  6001.       12th november 1997:
  6002.          + added text write for boolean (PM)
  6003.          * bug in secondcallparan for LOC_FPU (assumed that the type was double) (PM)
  6004.       13th november 1997:
  6005.          + added partial code for u32bit support (PM)
  6006.       22th november 1997:
  6007.          * bug in stack alignment found (PM)
  6008.  
  6009. }
  6010.